Excel VBA көмегімен мекен-жайлар үшін ендік және бойлық координаттарын алу үшін географиялық құрал қалай жасалады

Қазір бөлісу:

Осы мақаланы орындаңыз және географиялық құрал құрыңыз, оның көмегімен мекен-жай бойынша ендік пен бойлық координаттарын ала аласыз. Мұндай түрлендіргіштерді әдетте жылжымайтын мүлік брокерлері пайдаланады.

Енді жүктеп

Егер сіз бағдарламалық жасақтаманы мүмкіндігінше тезірек пайдалана бастағыңыз келсе, онда сіз:

Бағдарламалық жасақтаманы қазір жүктеп алыңыз

Әйтпесе, егер сіз өзіңіздің қолыңызбен жасағыңыз келсе, төмендегі мазмұнды оқи аласыз.

GUI-ді дайындайық

Сізге тек бір ғана Excel парағы қажет және сіз парақты өз қажеттіліктеріңізге сай атай аласыз. Бұл мысалда мен әдепкі парақ атауын «Sheet1» қолданамын. Келесі қадам - ​​осы параққа қажетті тақырыптарды қосу. Ендік, бойлық түрлендіргіші енгізу кезінде қала маңы, штат, пошта индексі және ел болса, біз беретін мекенжай үшін дәл нәтиже береді. Суретте көрсетілгендей, тақырыптарды дайындаңыз. Соңғы екі баған ретінде ендік пен бойлықты қосайық. Сондай-ақ, пайдаланушыға түрлендіруді орындауға мүмкіндік беретін түйме қажет. Сондықтан пішінді енгізіп, оны түйме ретінде көрсету үшін түспен толтырайық.GUI-ді дайындаңыз

Оны функционалды етейік

Мұнда берілген сценарий жаңа модульге көшірілуі керек. Жұмыс кітабын макро қосылған жұмыс кітабының файлы ретінде сақтауды ұмытпаңыз. «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 бағдарламасын түзету үшін.

Автордың кіріспесі:

Ник Випонд - деректерді қалпына келтіру бойынша сарапшы DataNumen, Соның ішінде деректерді қалпына келтіру технологиялары бойынша әлемдік көшбасшы болып табылатын Inc. құжатты жөндеу және қалпына келтіру бағдарламалық жасақтамасының өнімдері. Қосымша ақпарат алу үшін кіріңіз WWW.datanumen.com

Қазір бөлісу:

Пікірлер жабылды.