Excel VBA-тэй хаягуудын өргөрөг ба уртрагийн координатыг авахын тулд газарзүйн хэрэгсэл хэрхэн үүсгэх вэ?

Excel шийдэл Аравдугаар сар 3, 2025

Энэ нийтлэлийг дагаж, хаягийн өргөрөг, уртрагийн координатыг олж авах боломжтой өөрийн газарзүйн хэрэгслийг байгуул. Үүнтэй адил хөрвүүлэгчийг үл хөдлөх хөрөнгийн зуучлагчид ихэвчлэн ашигладаг.

Одоо Татах

Хэрэв та хүсэж байгаа болtart програмыг аль болох богино хугацаанд ашиглахын тулд дараахь зүйлийг хийж болно.

Програмыг одоо татаж аваарай

Үгүй бол, хэрэв та DIY хийхийг хүсвэл доорхи агуулгыг уншиж болно.

GUI-г бэлдэцгээе

Танд ердөө ганц Excel хуудас байхад л хангалттай бөгөөд та хэрэгцээнийхээ дагуу хуудсаа нэрлэж болно. Энэ жишээнд би хуудасны анхдагч нэрийг “Sheet1” ашиглаж байна. Дараагийн алхам бол энэ хуудсан дээр шаардлагатай толгойг нэмэх явдал юм. Өргөрөг, уртрагийн хөрвүүлэгч нь оролтод хотын зах, муж, х орсон тохиолдолд дамжуулж буй хаягийн зөв үр дүнг өгдөгostкод болон улс. Зураг дээр үзүүлсэн шиг толгойг бэлтгэ. Өргөрөг ба уртрагийг сүүлийн хоёр баганаар нэмье. Хэрэглэгч хөрвүүлэлтийг хийх боломжийг олгох товчлуур хэрэгтэй. Тиймээс Shape-г оруулаад өнгөөр дүүргээд товчлуур шиг харагдуулъя.

Үүнийг функциональ болгоё

Энд оруулсан скриптийг шинэ модуль руу хуулах хэрэгтэй. Ажлын номоо макро идэвхжүүлсэн ажлын номны файл болгон хадгалахаа бүү мартаарай. "FindThis" дэд хэсгийг бидний шинээр үүсгэсэн товчлуурт хавсаргасан байх ёстой.

Үүнийг туршиж үзье

Бусад мэдээллийн хамт хаягийг холбогдох баганад нэмнэ үү. Хуудсан дээрх бүх хаягийн лат ба урт координатыг харуулах макро ажиллуулахын тулд товчлуур дээр дарна уу. Макро star2-р мөрөнд хоосон мөрөнд хүрэх хүртэл үргэлжлүүлэн ажиллана.

Хэрхэн ажилладаг?

Скриптийн тусламжтайгаар бид хоёр функцийг бий болгосон. Нэг нь Лат утгыг, нөгөө нь урт утгыг авахад зориулагдсан. FOR давталтыг ашиглан бид хаяг бүрийг эдгээр функцүүдэд дамжуулж, үр дүнг дэлгэц дээр харуулах болно.

Script

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-ийг засах.

Зохиогчийн танилцуулга:

Ник Випонд бол мэдээлэл сэргээх мэргэжилтэн юм DataNumen, Үүнд мэдээлэл сэргээх технологиор дэлхийд тэргүүлэгч, Inc. засварлах асуудал болон хэтийн төлөвийг сэргээх програм хангамжийн бүтээгдэхүүнүүд. Дэлгэрэнгүй мэдээллийг авна уу WWW.datanumen.com