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

我有一个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

可以指定国家的名称吗？ 对

方法1：使用Excel

实现这一目标的一种方法是在第五栏中加入城市和乡村的组合

例如： 在单元格E2中，输入

=B2&“&D2

，然后向下填充，以使用城市名称和国家代码的组合填充新的第5列，中间使用空格字符。（然后需要编辑代码，以便例程使用此新输出作为查找基础）

方法2：使用VBA

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

例如，您可以尝试替换以下内容：

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

为此：

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

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

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

%20

：

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

或者将其替换为连字符（

-

）：

就我个人而言，我会先尝试带有

%20

的。请注意，这些都没有经过测试

在任何情况下，您还需要更换：

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

为此：

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

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

。。。还有

还有别的更快的方法吗？

---

不确定它是否会更快，但Excel现在可以通过使用地理数据类型在没有VBA的情况下以本机方式完成这项工作。此解决方案可能需要最新的软件版本。您可能更愿意坚持使用您开发的解决方案，因为您提到它可以工作并且速度足够快。如果感兴趣，您可以在上看到使用新功能的示例。此示例使用新的LAMBDA函数定义计算，但您现在可以忽略此步骤，只需输入示例中显示的完整计算。

如果您可以访问所有数据，则可以使用单元格公式创建一个新列，如

=CityRange&'-'&CountryCodeRange

其中CityRange，CountryCodeRange是单元格范围，即$A$2、$C$2

因此，当您查询一些地方时，您应该将它们称为

CityName&'-'&CountryCode

，例如：BREST-FR而不是BREST

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

---

正如我所看到的，您的代码有一些下载部分。

谢谢您的回答，将城市和国家连接到第五列是什么意思？只有前两个用于计算两者之间的距离。作为数据我可以有城市，国家和邮政编码，我没有精确的GPS坐标。是的，这取决于城市的数量，但总体上治疗速度相当快。我编辑了新专栏，展示了一种可能的公式方法。这结合了城市和国家代码，中间有一个空格。我相信网站前端接受这些组合（例如，

Brest FR

）并正确处理它们，但您应该根据您的期望进行测试。感谢您的详细回答和具体示例，这对我有很大帮助！另一方面，我用VBA方法测试了您的各种可能性，但每次执行宏时，我在这一行上出现错误……请尝试将以下内容放在该行上方的新行中，该行显示为

Msgbox（Data（I，4））

，并告诉我们运行该对话框时对话框显示的内容。如果出现编译错误，保留这一新行，但将原始行恢复到原来的状态。我希望对话框会显示

FR

。很高兴听到它在工作。我建议你现在就这个新问题提出一个新问题。如果您有一个正确连接的名称列表，您可以编写一个函数，将它们拆分为一个基本名称列表。这将为您提供两列，然后您可以插入一个步骤从另一列中查找。我的城市和国家的数据直接从其他Excel文件中获取。因此，我将在这个新列上进行计算？要么对每个文件执行此操作，要么在搜索代码运行时执行此操作，逐个检查这两个参数的值。