Følg denne artikel og opret dit eget geografiske værktøj, som du kan få bredde- og længdegradskoordinaterne til en adresse med. Omformere som dette bruges ofte af ejendomsmæglere.
Hent nu
Hvis du vil begynde at bruge softwaren så hurtigt som muligt, kan du:
Ellers kan du læse indholdet nedenfor, hvis du vil gøre det selv.
Lad os forberede GUI
Alt du behøver er et enkelt Excel-ark, og du kan navngive arket efter behov. I dette eksempel bruger jeg standardarknavnet "Ark1". Det næste trin er at tilføje de nødvendige overskrifter på dette ark. Konverteren for breddegrad og længdegrad giver et nøjagtigt resultat for den adresse, vi indtaster, hvis inputtet inkluderer forstad, stat, postnummer og land. Som vist på billedet skal du forberede overskrifterne. Lad os tilføje breddegrad og længdegrad som de sidste to kolonner. Vi har også brug for en knap, der giver brugeren mulighed for at udføre konverteringen. Lad os indsætte en figur og udfylde den med farve for at få den til at se ud som en knap.
Lad os gøre det funktionelt
Det script, der er angivet her, skal kopieres til et nyt modul. Glem ikke at gemme din projektmappe som en makroaktiveret projektmappefil. Sub “FindThis” skal vedhæftes den knap, vi lige har oprettet.
Lad os teste det
Tilføj adresse sammen med andre oplysninger i de respektive kolonner. Klik på knappen for at køre makroen, som viser bredde- og længdekoordinater for alle adresser, der er angivet på arket. Makroen starter i række 2 og fortsætter med at køre, indtil den når en tom række.
Hvordan det virker?
Med scriptet har vi oprettet to funktioner. En til at hente Lat-værdi og en anden til at hente Long-værdi. Ved hjælp af en FOR-loop sender vi hver adresse til disse funktioner og viser resultatet på skærmen.
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
Hvis du ikke modtager ordentlige resultater ved hjælp af scriptet, kan beskadiget excel være en sandsynlig årsag. Du kan derefter bruge Excel-filgendannelsesværktøj som DataNumen Excel Repair at rette Excel.
Forfatter Introduktion:
Nick Vipond er en datagendannelsesekspert i DataNumen, Inc., som er verdens førende inden for datagendannelsesteknologier, herunder reparation doc problem og Outlook Outlook-softwareprodukter. For mere information besøg www.datanumen.com