订阅怎么计算距离某一点最近的20个数据？
来源：网络收集 点击： 时间：2024-04-29先按照以下格式输入数据。
2/7在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/7保存EXCEL为启用宏的工作簿，后缀是.XLSM。
4/7插入按钮
5/7指定宏或者VBA代码给这个按钮
6/7选择VBA代码，点击确定
7/7更改按钮名字，通常选择浅显易懂的名字。
注意事项EXCEL格式是xlsm。
最近距离版权声明：
1、本文系转载，版权归原作者所有，旨在传递信息，不代表看本站的观点和立场。
2、本站仅提供信息发布平台，不承担相关法律责任。
3、若侵犯您的版权或隐私，请联系本站管理员删除。
4、文章链接：http://www.1haoku.cn/art_626051.html
