ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Excel VBA locate nearest point (https://www.excelbanter.com/excel-programming/388148-excel-vba-locate-nearest-point.html)

[email protected]

Excel VBA locate nearest point
 
HI everyone

I hav sent a post earlier [match numerical data using excel vba] , wel
after posting that i thot abt it more n sipplified this
way ............

I have x,y coordinates of say 1000 points [no. of points vary ] (data
set 1) n also dataset2 of around 2500 points ....

now i want to locate the nearest coordinate using formula

d = ((x2-x1)^2+(y2-y1)^2) should be minimum , but i m unable to
program it correctly

say for example here are two data sets
dataset1 a1:b9 dataset2 e1:f9
data set 1 dataset 2

1 9 9 1
2 8 8 2
3 7 7 3
4 6 6 4
5 5 5 5
6 4 4 6
7 3 3 7
8 2 2 8
9 1 1 9

dataset above is not actual , its just an example
now wat i want to do it to first of chk cell(1,1) and cell(1,2)
values [dataset1] and find distance using coordinates of dataset and
where evr it find minimum distane "d" [ in above xaple its cell(9 ,
5 ) n cell(9,6 )]
copy the cooresponding coordinates n front of dataset1
values that is in cell(1,3) and cell(1,4)

i hope i hav made my problem clear, for further xplaination plz let me
knw

Many thanks for any or all suggestions


sali[_2_]

Excel VBA locate nearest point
 
wrote in message
ups.com...
HI everyone


d = ((x2-x1)^2+(y2-y1)^2) should be minimum , but i m unable to
program it correctly


very simple example, what about:
--------------------8<---------

Const rownum1 = 10 'rows of column1
Const rownum2 = 20 'rows of column2
Const min0 = 1000 'starting minimum, but enough big to be bigger than final

Sub distance1()
Dim i As Integer, j As Integer, d As Double, dmin As Double, rmin As
Integer
With ActiveSheet
For i = 1 To rownum1
dmin = min0
rmin = -1
For j = 1 To rownum2
d = d1(.Cells(i, 1), .Cells(j, 5), .Cells(i, 2), .Cells(j,
6))
If d < dmin Then
rmin = j
dmin = d
End If
Next
.Cells(i, 7).Value = rmin
.Cells(i, 8).Value = dmin
.Cells(i, 3).Value = .Cells(rmin, 5)
.Cells(i, 4).Value = .Cells(rmin, 6)
Next
End With
End Sub

Function d1(x1 As Double, x2 As Double, y1 As Double, y2 As Double) As
Double
d1 = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function




joel

Excel VBA locate nearest point
 
This will get your answers. If two distances are the same, it will use the
one in the lowest row.


Sub sortdistance()

LastRowA = Cells(Rows.Count, "A").End(xlUp).Row
LastRowE = Cells(Rows.Count, "E").End(xlUp).Row


For i = 1 To LastRowA
X = Cells(i, "A")
Y = Cells(i, "B")

For j = 1 To LastRowE
distance = Sqr((X - Cells(j, "E")) ^ 2 + (Y - Cells(j, "F")) ^ 2)
If j = 1 Then
shortX = Cells(j, "E")
shortY = Cells(j, "F")
shortdistance = distance
Else
If distance < shortdistance Then
shortX = Cells(j, "E")
shortY = Cells(j, "F")
shortdistance = distance
End If
End If
Next j

Cells(i, "C") = shortX
Cells(i, "D") = shortY
Next i

End Sub


" wrote:

HI everyone

I hav sent a post earlier [match numerical data using excel vba] , wel
after posting that i thot abt it more n sipplified this
way ............

I have x,y coordinates of say 1000 points [no. of points vary ] (data
set 1) n also dataset2 of around 2500 points ....

now i want to locate the nearest coordinate using formula

d = ((x2-x1)^2+(y2-y1)^2) should be minimum , but i m unable to
program it correctly

say for example here are two data sets
dataset1 a1:b9 dataset2 e1:f9
data set 1 dataset 2

1 9 9 1
2 8 8 2
3 7 7 3
4 6 6 4
5 5 5 5
6 4 4 6
7 3 3 7
8 2 2 8
9 1 1 9

dataset above is not actual , its just an example
now wat i want to do it to first of chk cell(1,1) and cell(1,2)
values [dataset1] and find distance using coordinates of dataset and
where evr it find minimum distane "d" [ in above xaple its cell(9 ,
5 ) n cell(9,6 )]
copy the cooresponding coordinates n front of dataset1
values that is in cell(1,3) and cell(1,4)

i hope i hav made my problem clear, for further xplaination plz let me
knw

Many thanks for any or all suggestions




All times are GMT +1. The time now is 12:12 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com