如何创建地理工具以使用 Excel VBA 获取地址的经纬度坐标

Excel 解决方案 2025 年 10 月 3 日

按照本文构建您自己的地理工具，您可以使用该工具获取地址的纬度和经度坐标。像这样的转换器通常被房地产经纪人使用。

立即下载

如果您想尽快开始使用该软件，那么您可以：

否则，如果你想DIY，你可以阅读下面的内容。

让我们准备 GUI

您只需要一个 Excel 工作表，可以根据需要命名。在本例中，我使用默认的工作表名称“Sheet1”。下一步是在该工作表中添加必要的标题。如果输入的地址包含郊区、州/省、邮政编码和国家/地区，经纬度转换器就能给出准确的结果。如图所示，准备标题。我们将经纬度作为最后两列添加。我们还需要一个按钮来允许用户进行转换。因此，让我们插入一个形状并填充颜色，使其看起来像一个按钮。

让我们让它发挥作用

此处提供的脚本应复制到新模块中。不要忘记将您的工作簿保存为启用宏的工作簿文件。子“FindThis”应该附加到我们刚刚创建的按钮。

让我们测试一下

将地址及其他信息添加到相应的列中。单击按钮运行宏，该宏将显示表格中所有地址的经纬度坐标。宏将从第 2 行开始运行，直到遇到空行为止。

如何运作的？

使用脚本，我们创建了两个函数。一个用于获取 Lat 值，另一个用于获取 Long 值。使用 FOR 循环，我们将每个地址传递给这些函数并在屏幕上显示结果。

脚本

Function GETLAT(v_address As String, v_suburb As String, v_state As String, v_postcode As Long)
    
    Dim URl As String, lastRow As Long
    Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
    
    URl = "https://maps.googleapis.com/maps/api/geocode/xml?address=" & Application.WorksheetFunction.Substitute(v_address, " ", "+") & Application.WorksheetFunction.Substitute(v_suburb, " ", "+") & Application.WorksheetFunction.Substitute(v_state, " ", "+") & Application.WorksheetFunction.Substitute(v_postcode, " ", "+") & ",Australia"
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", URl, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send
    
    Set html = CreateObject("htmlfile")
    html.body.innerhtml = xmlHttp.ResponseText
    v_string = html.body.innerhtml
    x = InStr(1, v_string, "<LAT>")
    If x <> 0 Then
        y = InStr(x + 5, v_string, "</LAT>")
        GETLAT = Mid(v_string, x + 5, y - (x + 5))
    End If
End Function

Function GETLNG(v_address As String, v_suburb As String, v_state As String, v_postcode As Long)
    
    Dim URl As String, lastRow As Long
    Dim xmlHttp As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
    
    URl = "https://maps.googleapis.com/maps/api/geocode/xml?address=" & Application.WorksheetFunction.Substitute(v_address, " ", "+") & Application.WorksheetFunction.Substitute(v_suburb, " ", "+") & Application.WorksheetFunction.Substitute(v_state, " ", "+") & Application.WorksheetFunction.Substitute(v_postcode, " ", "+") & ",Australia"
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", URl, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send
    
    Set html = CreateObject("htmlfile")
    html.body.innerhtml = xmlHttp.ResponseText
    v_string = html.body.innerhtml
    
    x = InStr(1, v_string, "<LNG>")
    If x <> 0 Then
        y = InStr(x + 5, v_string, "</LNG>")
        GETLNG = Mid(v_string, x + 5, y - (x + 5))
    End If
End Function

Sub FindThis()
    For r = 2 To 5
        Range("F" & r).Value = GETLAT(Range("A" & r).Value, Range("B" & r).Value, Range("C" & r).Value, Range("D" & r).Value)
        Range("G" & r).Value = GETLNG(Range("A" & r).Value, Range("B" & r).Value, Range("C" & r).Value, Range("D" & r).Value)
    Next r
End Sub

如果您使用脚本没有收到正确的结果，损坏的 excel 可能是一个可能的原因。然后你可以使用 Excel文件恢复工具如 DataNumen Excel Repair 修复 Excel。

作者简介：

Nick Vipond 是一位数据恢复专家 DataNumen, Inc.，它是数据恢复技术领域的世界领先者，包括修复文档问题和 outlook 恢复软件产品。欲了解更多信息，请访问 datanumen.com