查找不同坐标之间的距离

Find Distance between different coordinates

我有 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&L2L1&L3L1&L4L2&L3L2&L4 和 [=17= 之间的距离]

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 个位置)?

我会使用矩阵。 为地理编码创建一个 sheet(如 'GeocodeList' 或其他东西),例如问题中的城市|纬度|经度。然后为矩阵创建一个 sheet(如 'Distances'),其中列和行标签是城市名称。然后,您可以使用 V.LOOKUPs 参数化您的 excel 公式,从 GeocodeList 中查找准确的代码。

公式如下所示(X 是行号,Y 是列字母。):

=ACOS(COS(RADIANS(90-VLOOKUP($A(X); GEOCODETABLE, LATCOLINDEX, 0)))
*COS(RADIANS(90-VLOOKUP((Y); GEOCODETABLE; LATCOLINDEX, 0)))
+SIN(RADIANS(90-VLOOKUP($A(X); GEOCODETABLE, LATCOLINDEX, 0)))
*SIN(RADIANS(90-VLOOKUP((Y); GEOCODETABLE; LATCOLINDEX, 0)))
*COS(RADIANS(VLOOKUP($A(X); GEOCODETABLE, LATCOLINDEX, 0)-VLOOKUP((Y); GEOCODETABLE; LONCOLINDEX, 0))))
*6371

基本上 VLOOKUP 会自动获取您的参数,您可以扩展整个矩阵的公式。

或者,您可以创建一个 VBA 函数,然后循环遍历您的 table。

将此代码添加到 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 中循环遍历所有可能的组合。输出立即 window.

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


EDIT - 要将输出更改为 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