如何在VBA中指定国家来计算两个城市之间的距离？
How to calculate the distance between two cities by specifying the country in 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
是否可以指定国家名称？
是的。
方法一：用Excel
实现此目的的一种方法是在第 5 列中包含城市和国家/地区的组合。
例如：
在单元格 E2 中，输入 =B2&" "&D2 然后向下填充，以使用城市名称和国家/地区代码的组合填充新的第 5 列，中间有一个 space 字符。 （然后您需要编辑您的代码，以便例程使用这个新输出作为查找基础）。
方法二：用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)
但是，您可能需要将串联 space 编码为 %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 的那个。请注意，其中 none 个已经过测试。
无论如何你还需要替换这个：
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 函数定义计算，但您现在可以忽略此步骤，只需输入示例中显示的完整计算即可。
如果您有权访问所有数据，您可以使用 =CityRange & '-' & CountryCodeRange 等单元格公式创建一个新列，其中 CityRange、CountryCodeRange 是单元格范围，即 $A$2、$C$2。
因此，当您查询某些地点时，您应该将它们称为 CityName & '-' & CountryCode，例如：BREST-FR 而不是 BREST。
但是如果您从网络下载数据，您应该检查您下载的每个页面的两个参数以选择您想要的值。
我看到你的代码有一些下载部分。
我有一个 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
是否可以指定国家名称？
是的。
方法一：用Excel
实现此目的的一种方法是在第 5 列中包含城市和国家/地区的组合。
例如：
在单元格 E2 中，输入 =B2&" "&D2 然后向下填充，以使用城市名称和国家/地区代码的组合填充新的第 5 列，中间有一个 space 字符。 （然后您需要编辑您的代码，以便例程使用这个新输出作为查找基础）。
方法二：用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)
但是，您可能需要将串联 space 编码为 %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 的那个。请注意，其中 none 个已经过测试。
无论如何你还需要替换这个：
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 函数定义计算，但您现在可以忽略此步骤，只需输入示例中显示的完整计算即可。
如果您有权访问所有数据，您可以使用 =CityRange & '-' & CountryCodeRange 等单元格公式创建一个新列，其中 CityRange、CountryCodeRange 是单元格范围，即 $A$2、$C$2。
因此，当您查询某些地点时，您应该将它们称为 CityName & '-' & CountryCode，例如：BREST-FR 而不是 BREST。
但是如果您从网络下载数据，您应该检查您下载的每个页面的两个参数以选择您想要的值。
我看到你的代码有一些下载部分。