Noudata tätä artikkelia ja luo oma maantieteellinen työkalu, jolla voit saada osoitteen leveys- ja pituuskoordinaatit. Kiinteistönvälittäjät käyttävät tavallisesti tällaisia muuntimia.
Lataa nyt
Jos haluat aloittaa ohjelmiston käytön mahdollisimman pian, voit:
Muussa tapauksessa voit lukea sisällön alla olevasta sisällöstä.
Valmistellaan käyttöliittymä
Tarvitset vain yhden Excel-taulukon, ja voit nimetä taulukon tarpeidesi mukaan. Tässä esimerkissä käytän oletusarvoista taulukon nimeä "Taul1". Seuraava vaihe on lisätä tarvittavat otsikot tälle taulukolle. Leveys- ja pituusasteiden muunnin antaa tarkan tuloksen välitetylle osoitteelle, jos syöte sisältää esikaupungin, osavaltion, postinumeron ja maan. Kuten kuvassa näkyy, valmistele otsikot. Lisäämme leveys- ja pituusasteet kahdeksi viimeiseksi sarakkeeksi. Tarvitsemme myös painikkeen, jotta käyttäjä voi tehdä muunnoksen. Lisää siis muoto ja täytä se värillä, jotta se näkyy painikkeena.
Tehdään siitä toimiva
Tässä annettu komentosarja tulee kopioida uuteen moduuliin. Älä unohda tallentaa työkirjaasi makrokäyttöisenä työkirjatiedostona. Ala "FindThis" tulisi liittää juuri luomaan painikkeeseen.
Testataan se
Lisää osoite ja muut tiedot vastaaviin sarakkeisiin. Napsauta painiketta suorittaaksesi makron, joka näyttää kaikkien taulukossa lueteltujen osoitteiden leveys- ja pituuskoordinaatit. Makro alkaa riviltä 2 ja jatkuu, kunnes se saavuttaa tyhjän rivin.
Kuinka se toimii?
Skriptin avulla olemme luoneet kaksi toimintoa. Yksi lat-arvon noutamiseksi ja toinen pitkän arvon noutamiseksi. FOR-silmukan avulla välitämme jokaisen osoitteen näille toiminnoille ja näytämme tuloksen näytöllä.
Käsikirjoitus
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
Jos et saa kunnollisia tuloksia komentosarjan avulla, vioittunut Excel voi olla todennäköinen syy. Voit sitten käyttää Excel-tiedostojen palautustyökalu kuten DataNumen Excel Repair korjata Excel.
Tekijän esittely:
Nick Vipond on tietojen palauttamisen asiantuntija DataNumen, Inc., joka on maailman johtava tietojen palautustekniikoissa, mukaan lukien korjaus doc ongelma ja Outlook-palautusohjelmistotuotteet. Lisätietoja osoitteessa www.datanumen.com