View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
sali[_2_] sali[_2_] is offline
external usenet poster
 
Posts: 24
Default 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