Question

我有一个 VBA 脚本，可以让我以公里为单位计算两个城市之间的距离。

此脚本基于以下站点：http://www.distance2villes.com/

它运行得非常好且快速，因为我有包含数千个城市的 Excel 文件，因此每次都要计算距离。

问题是我有时会遇到同名但位于不同欧洲国家/地区的城市。如下例所示：Brest 是在白俄罗斯查找，而不是在法国查找城市。

Starting city   City of destination Distance Country
Soorts-Hossegor ST PIERRE QUIBERON  668     FR
Soorts-Hossegor ST AUSTELL          1198    GB
Soorts-Hossegor KIEL                1724    DE
Soorts-Hossegor BREST               2612    FR
Soorts-Hossegor WIEN                1850    AT
Soorts-Hossegor CHAMONIX MONT BLANC 948     FR
Soorts-Hossegor CORNWALL            1169    GB
Soorts-Hossegor CORNWALL            1169    GB
Soorts-Hossegor BREST               2612    FR
Soorts-Hossegor ROME                1556    IT
Soorts-Hossegor BOURNEMOUTH         960     GB
Soorts-Hossegor CORNWALL            1169    GB
Soorts-Hossegor ROTTENBURG AM NECKAR 1201   DE
Soorts-Hossegor LA CROIX VALMER      795    FR

当城市很多时，是否可以指定要搜索的国家/地区的名称以避免这种混淆？或者是否有另一种更快的方法来计算 Excel 中两个城市之间的距离？

Option Explicit

Sub Distance()
    
    Const DIST1 As String = "http://www.distance2villes.com/recherche?source="
    Const DIST2 As String = "&destination="
    Const DIST3 As String = "distanciaRuta"
    Const wsName As String = "Feuil1"
    
    'Dim w As Object: Set w = CreateObject("WINHTTP.WinHTTPRequest.5.1")
    Dim w As Object: Set w = CreateObject("MSXML2.XMLHTTP")
    Dim h As Object: Set h = CreateObject("htmlfile")
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(wsName)
    Dim rg As Range
    Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(, 1))
    Dim Data As Variant: Data = rg.Value
    
    Dim isFound As Boolean: isFound = True
    Dim i As Long
    Dim Url As String
    Dim S As String
    
    For i = 1 To UBound(Data, 1)
        If Len(Data(i, 1)) > 0 And Len(Data(i, 2)) > 0 Then
            Url = DIST1 & Data(i, 1) & DIST2 & Data(i, 2)
            w.Open "GET", Url, False
            w.Send
            h.body.innerHTML = w.responseText
            On Error GoTo NotFoundError
            S = h.getElementById(DIST3).innerText
            On Error GoTo 0
            If isFound Then
                Data(i, 1) = Replace(Left(S, Len(S) - 3), ",", "")
            Else
                Data(i, 1) = ""
                isFound = True
            End If
        Else
            Data(i, 1) = ""
        End If
    Next
    rg.Columns(1).Offset(, 2).Value = Data
    
    Exit Sub

NotFoundError:
    isFound = False
    Resume Next

End Sub

Answer 1

是否可以指定国家/地区名称？

是的。

方法一：用Excel

实现这一目标的一种方法是使用包含城市和国家/地区组合的第 5 列。

例如：在单元格 E2 中，输入 =B2&" "&D2 然后向下填充，用城市名称和国家代码的组合填充新的第 5 列，中间有空格字符。（然后您需要编辑您的代码，以便例程使用这个新输出作为查找基础）。

方法 2：使用 VBA

另一种方法是在 VBA 中将城市和国家连接成一个查找字符串，就像现在这样从 Excel 中提取出来，而不是像上面的建议那样先在 Excel 中连接它。

例如，您可以尝试替换它：

Url = DIST1 & Data(i, 1) & DIST2 & Data(i, 2)

有了这个：

Url = DIST1 & Data(i, 1) & DIST2 & Data(i, 2) & " " & Data(i, 4)

但是，您可能需要将连接空间编码为 %20：

Url = DIST1 & Data(i, 1) & DIST2 & Data(i, 2) & "%20" & Data(i, 4)

或者将其替换为连字符 (-)：

Url = DIST1 & Data(i, 1) & DIST2 & Data(i, 2) & "-" & Data(i, 4)

我个人会先尝试使用 %20 的那个。请注意，这些都没有经过测试。

无论如何，您还需要替换它：

Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(, 1))

有了这个：

Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(, 3))

...也是。

还有其他更快的方法吗？

不确定它是否会更快，但 Excel 现在可以通过使用地理数据类型在没有 VBA 的情况下本机执行此操作。此解决方案可能需要最新的软件版本。您可能更愿意坚持使用您开发的解决方案，因为您提到它有效并且足够快。如果有兴趣，您可以在 https://techcommunity.microsoft.com/t5/excel/lambda-examples-distance-between-two-cities/m-p/1952946 查看使用新功能的示例。此示例使用新的 LAMBDA 函数定义计算，但您现在可以忽略此步骤，只需输入示例中显示的完整计算。

Answer 2

如果您有权访问所有数据，您可以创建一个包含单元格公式的新列，例如 =CityRange & '-' & CountryCodeRange，其中 CityRange、CountryCodeRange 是单元格范围，即 $A$2、$C$2。

因此，当您查询某些地方时，您应该将它们称为 CityName & '-' & CountryCode，例如：BREST-FR 而不是 BREST。

但是如果您从网络下载数据，您应该检查您下载的每个页面的两个参数以选择您想要的值。

我可以看到你的代码有一些下载部分。

如何通过在VBA中指定国家来计算两个城市之间的距离？

2 个答案:

是否可以指定国家/地区名称？

还有其他更快的方法吗？