如何利用VBA轻松计算距离最近的20个数据
网络优化工程师在工作中常需要计算距离一个站点最近的20个小区，但逐个计算过于繁琐。利用VBA编程可以轻松实现这一任务。
准备数据格式和VBA代码
首先，按照指定的格式输入数据。然后，在VBA编辑器中输入以下代码：
```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 (Columns(1))
If maxrow > 2 Then
Range(Cells(2, 1), Cells(maxrow, 7)).Select
End If
Sheets("输入有需求的站点").Select
s_maxrow (Columns(1))
Sheets("输入全网数据").Select
t_maxrow (Columns(1))
If s_maxrow < 2 Or t_maxrow < 2 Then
MsgBox("对不起, 输入有需求的站点表或者输入全网数据表中没有数据,请确认!!!")
End If
rowvar 2
For s_rowvar 2 To s_maxrow
s_longitude ("输入有需求的站点").Cells(s_rowvar, 2)
s_latitude ("输入有需求的站点").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(((s_longitude - t_longitude) * 98.22, (s_latitude - t_latitude) * 111.22))
distance (distance * 1000, 0)
If cellnum < 20 Then
If distance > max_distance Then
max_distance distance
t_row rowvar
End If
("输出结果").Cells(rowvar, 1) ("输入有需求的站点").Cells(s_rowvar, 1)
("输出结果").Cells(rowvar, 2) ("输入有需求的站点").Cells(s_rowvar, 2)
("输出结果").Cells(rowvar, 3) ("输入有需求的站点").Cells(s_rowvar, 3)
("输出结果").Cells(rowvar, 4) distance
("输出结果").Cells(rowvar, 5) ("输入全网数据").Cells(t_rowvar, 1)
("输出结果").Cells(rowvar, 6) ("输入全网数据").Cells(t_rowvar, 2)
("输出结果").Cells(rowvar, 7) ("输入全网数据").Cells(t_rowvar, 3)
rowvar rowvar 1
cellnum cellnum 1
ElseIf distance < max_distance Then
("输出结果").Cells(t_row, 4) distance
("输出结果").Cells(t_row, 5) ("输入全网数据").Cells(t_rowvar, 1)
("输出结果").Cells(t_row, 6) ("输入全网数据").Cells(t_rowvar, 2)
("输出结果").Cells(t_row, 7) ("输入全网数据").Cells(t_rowvar, 3)
max_distance distance
For c_rowvar s_row To rowvar - 1
If ("输出结果").Cells(c_rowvar, 4) > max_distance Then
max_distance ("输出结果").Cells(c_rowvar, 4)
t_row c_rowvar
End If
Next
End If
Next
Next
Sheets("输出结果").Select
maxrow (Columns(1))
("输出结果")
("输出结果") Key:Range(Cells(2, 1), Cells(maxrow, 1)), SortOn:xlSortOnValues, Order:xlAscending, DataOption:xlSortNormal
("输出结果") Key:Range(Cells(2, 4), Cells(maxrow, 4)), SortOn:xlSortOnValues, Order:xlAscending, DataOption:xlSortNormal
With ("输出结果").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
```
配置并保存文件
1. 将Excel文件保存为启用宏的工作簿，后缀为.XLSM。
2. 插入按钮并指定宏或VBA代码给按钮。
3. 选择VBA代码后，更改按钮名称为易懂的描述。
版权声明：本文内容由互联网用户自发贡献，本站不承担相关法律责任.如有侵权/违法内容,本站将立刻删除。
