lat

Question

我有1000个地点的位置数据（经度和纬度），需要计算每个地点之间的距离，每次需要两个组合。

例如：我有四个地点的数据（经纬度），需要计算每个地点之间的距离，一次取两个组合。

假设我有四个位置数据（经纬度数据） 想计算它们之间的距离。

    Location      Latitude    Longitude

 1. New York(L1)  40.7128° N  74.0060° W
 2. Paris(L2)     48.8566° N   2.3522° E
 3. London(L3)    51.5074° N   0.1278° W
 4. Moscow(L4)    55.7558° N  37.6173° E

需要计算可能的组合之间的距离，即以下组合之间的距离 L1&L2, L1&L3, L1&L4, L2&L3, L2&L4 和 L3&L4

我用来计算距离的Excel公式是

=ACOS(COS(RADIANS(90-Lat1)) *COS(RADIANS(90-Lat2)) +SIN(RADIANS(90-Lat1)) *SIN(RADIANS(90-Lat2)) *COS(RADIANS(Long1-Long2))) *6371

我如何计算大型数据集，比如100个或1000个地点的数据？

Answer 1

另外，你也可以创建一个VBA函数，然后在你的表格中循环。

在VBA编辑器中，将此代码添加到一个模块中。

Public Function DistBetweenCoord(Lat1 As Double, Long1 As Double, Lat2 As Double, Long2 As Double)
    'Cell Formula
    'ACOS(COS(RADIANS(90-Lat1)) *COS(RADIANS(90-Lat2)) +SIN(RADIANS(90-Lat1)) *SIN(RADIANS(90-Lat2)) *COS(RADIANS(Long1-Long2))) *6371

    With WorksheetFunction
        A = Cos(.Radians(90 - Lat1))
        B = Cos(.Radians(90 - Lat2))
        C = Sin(.Radians(90 - Lat1))
        D = Sin(.Radians(90 - Lat2))
        E = Cos(.Radians(Long1 - Long2))

        DistBetweenCoord = .Acos(A * B + C * D * E) * 6371
    End With
End Function

现在你可以通过代码或在单元格中访问这个模块。 这里是一个单元格内的例子。

=DistBetweenCoord(C1,D1,C2,D2)

---

这里是如何在另一个Sub中循环所有可能的组合。 输出是在即时窗口中。

Sub CalcAllDistances()
    With Worksheets("Sheet1")
        For i = 1 To 4
            For j = i To 4
                If i <> j Then
                    Debug.Print .Cells(i, 2) & " to " & .Cells(j, 2) & ": " & DistBetweenCoord(.Cells(i, 3), .Cells(i, 4), .Cells(j, 3), .Cells(j, 4))
                End If
            Next j
        Next i
    End With
End Sub

---

编辑 - 要改变输出为Sheet2，请尝试以下方法。

Sub CalcAllDistances()
    Dim wks_Output As Worksheet
    Set wks_Output = Worksheets("Sheet2")

    Dim OutputRow As Long: OutputRow = 1

    With Worksheets("Sheet1")
        For i = 1 To 4
            For j = i To 4
                If i <> j Then
                    wks_Output.Cells(OutputRow, 1).Value = .Cells(i, 2) & " to " & .Cells(j, 2)
                    wks_Output.Cells(OutputRow, 2).Value = DistBetweenCoord(.Cells(i, 3), .Cells(i, 4), .Cells(j, 3), .Cells(j, 4))
                    OutputRow = OutputRow + 1
                End If
            Next j
        Next i
    End With
End Sub

Answer 2

我会使用一个矩阵.创建一个表（像'GeocodeList'或其他）的地理代码，像你的城市。