我有一个 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
答案 0 :(得分: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 函数定义计算,但您现在可以忽略此步骤,只需输入示例中显示的完整计算。
答案 1 :(得分:0)
如果您有权访问所有数据,您可以创建一个包含单元格公式的新列,例如 =CityRange & '-' & CountryCodeRange
,其中 CityRange、CountryCodeRange 是单元格范围,即 $A$2、$C$2。
因此,当您查询某些地方时,您应该将它们称为 CityName & '-' & CountryCode
,例如:BREST-FR 而不是 BREST。
但是如果您从网络下载数据,您应该检查您下载的每个页面的两个参数以选择您想要的值。
我可以看到你的代码有一些下载部分。