1、先按照以下格式输入数据。
2、在VBA中输入如下代码：Sub cell_location() Dim longtitude, latitude, s_longtitu颊俄岿髭de, 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、更改按钮名字，通常选择浅显易懂的名字。
