怎么计算距离某一点最近的20个数据？
1、先按照以下格式输入数据。
2、在VBA中输入如下代码：
Sub cell_location()
Dim longtitude, latitude, s_longtitude, s_latitude, t_longtitude, t_latitude, distance As Double
Dim max_distance As Long
Dim cell As String
Dim s_maxrow, t_maxrow, maxrow, cellnum, s_rowvar, t_rowvar, rowvar, c_rowvar As Long
Sheets("输出结果").Select
maxrow = Application.WorksheetFunction.CountA(Columns(1))
If maxrow > 2 Then
Range(Cells(2, 1), Cells(maxrow, 7)).Select
Selection.ClearContents
End If
Sheets("输入有需求的站点").Select
s_maxrow = Application.WorksheetFunction.CountA(Columns(1))
Sheets("输入全网数据").Select
t_maxrow = Application.WorksheetFunction.CountA(Columns(1))
If s_maxrow < 2 Or t_maxrow < 2 Then
MsgBox ("对不起, 输入有需求的站点 表 或者 输入全网数据 表中没有数据,请确认!!!")
End
End If
rowvar = 2
For s_rowvar = 2 To s_maxrow
s_longitude = Application.Worksheets("输入有需求的站点").Cells(s_rowvar, 2)
s_latitude = Application.Worksheets("输入有需求的站点").Cells(s_rowvar, 3)
s_row = rowvar
max_distance = 0
cellnum = 1
For t_rowvar = 2 To t_maxrow
t_longitude = Cells(t_rowvar, 2)
t_latitude = Cells(t_rowvar, 3)
distance = Sqr(Application.WorksheetFunction.SumSq((s_longitude - t_longitude) * 98.22, (s_latitude - t_latitude) * 111.22))
distance = Application.WorksheetFunction.Round(distance * 1000, 0)
If cellnum <= 20 Then
If distance > max_distance Then
max_distance = distance
t_row = rowvar
End If
Application.Worksheets("输出结果").Cells(rowvar, 1) = Application.Worksheets("输入有需求的站点").Cells(s_rowvar, 1)
Application.Worksheets("输出结果").Cells(rowvar, 2) = Application.Worksheets("输入有需求的站点").Cells(s_rowvar, 2)
Application.Worksheets("输出结果").Cells(rowvar, 3) = Application.Worksheets("输入有需求的站点").Cells(s_rowvar, 3)
Application.Worksheets("输出结果").Cells(rowvar, 4) = distance
Application.Worksheets("输出结果").Cells(rowvar, 5) = Application.Worksheets("输入全网数据").Cells(t_rowvar, 1)
Application.Worksheets("输出结果").Cells(rowvar, 6) = Application.Worksheets("输入全网数据").Cells(t_rowvar, 2)
Application.Worksheets("输出结果").Cells(rowvar, 7) = Application.Worksheets("输入全网数据").Cells(t_rowvar, 3)
rowvar = rowvar + 1
cellnum = cellnum + 1
ElseIf distance < max_distance Then
Application.Worksheets("输出结果").Cells(t_row, 4) = distance
Application.Worksheets("输出结果").Cells(t_row, 5) = Application.Worksheets("输入全网数据").Cells(t_rowvar, 1)
Application.Worksheets("输出结果").Cells(t_row, 6) = Application.Worksheets("输入全网数据").Cells(t_rowvar, 2)
Application.Worksheets("输出结果").Cells(t_row, 7) = Application.Worksheets("输入全网数据").Cells(t_rowvar, 3)
max_distance = distance
For c_rowvar = s_row To rowvar - 1
If Application.Worksheets("输出结果").Cells(c_rowvar, 4) > max_distance Then
max_distance = Application.Worksheets("输出结果").Cells(c_rowvar, 4)
t_row = c_rowvar
End If
Next
End If
Next
Next
Sheets("输出结果").Select
maxrow = Application.WorksheetFunction.CountA(Columns(1))
Cells.Select
ActiveWorkbook.Worksheets("输出结果").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("输出结果").Sort.SortFields.Add Key:=Range(Cells(2, 1), Cells(maxrow, 1)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("输出结果").Sort.SortFields.Add Key:=Range(Cells(2, 4), Cells(maxrow, 4)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("输出结果").Sort
.SetRange Range(Cells(1, 1), Cells(maxrow, 7))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells(1, 1).Select
End Sub
3、保存EXCEL为启用宏的工作簿，后缀是.XLSM。
4、插入按钮
5、指定宏或者VBA代码给这个按钮
6、选择VBA代码，点击确定
7、更改按钮名字，通常选择浅显易懂的名字。
