经纬度实战案例①:不用手动算!Excel 批量根据经纬度,自动匹配最近站点

Option Explicit

Sub DistanceMain()

Dim i, j, n, NowRowC, PlanRowC As Long

Dim NowArr, Arr1, PlanArr

Application.ScreenUpdating = False

NowRowC = Sheet1.[c65536].End(xlUp).Row

PlanRowC = Sheet2.[c65536].End(xlUp).Row

Sheet1.Range("D2:G" & NowRowC).ClearContents

NowArr = Sheet1.Range("A2:G" & NowRowC)

PlanArr = Sheet2.Range("A2:C" & PlanRowC)

ReDim Arr1(1 To UBound(PlanArr), 1 To 4)

For i = 1 To UBound(NowArr)

    n = 0

    For j = 1 To UBound(PlanArr)

            n = n + 1

            Arr1(n, 1) = Distance(NowArr(i, 2), NowArr(i, 3), PlanArr(j, 2), PlanArr(j, 3))

            Arr1(n, 2) = PlanArr(j, 1)

            Arr1(n, 3) = PlanArr(j, 2)

            Arr1(n, 4) = PlanArr(j, 3)

    Next

    Sheet1.Cells(i + 1, 5) = Application.Min(Application.Index(Arr1, 0, 1))

    Sheet1.Cells(i + 1, 4) = Arr1(Application.Match(Application.Min(Application.Index(Arr1, 0, 1)), Application.Index(Arr1, 0, 1), 0), 2)

    Sheet1.Cells(i + 1, 6) = Arr1(Application.Match(Application.Min(Application.Index(Arr1, 0, 1)), Application.Index(Arr1, 0, 1), 0), 3)

    Sheet1.Cells(i + 1, 7) = Arr1(Application.Match(Application.Min(Application.Index(Arr1, 0, 1)), Application.Index(Arr1, 0, 1), 0), 4)

Next

MsgBox "妈妈再也不用担心基站偏移了……(距离计算完成)"

Application.ScreenUpdating = True

End Sub

Function Distance(x1, y1, x2, y2)

    Distance = 6378137 * 2 * Application.Asin(Sqr(Application.SumSq(Sin((Application.Radians(y1) - Application.Radians(y2)) / 2)) + Cos(Application.Radians(y1)) * Cos(Application.Radians(y2)) * Application.SumSq(Sin((Application.Radians(x1) - Application.Radians(x2)) / 2))))

End Function

重新右键点击按扭，指定宏，选择刚建的宏；