Πώς να δημιουργήσετε ένα γεωγραφικό εργαλείο για να λάβετε συντεταγμένες γεωγραφικού πλάτους και μήκους για διευθύνσεις με το Excel VBA

Κοινή χρήση τώρα:

Ακολουθήστε αυτό το άρθρο και δημιουργήστε το δικό σας γεωγραφικό εργαλείο με το οποίο μπορείτε να λάβετε τις συντεταγμένες γεωγραφικού πλάτους και μήκους για μια διεύθυνση. Οι μετατροπείς όπως αυτό χρησιμοποιούνται συνήθως από μεσίτες ακινήτων.

Κατεβάστε το Δωρεάν Τώρα

Εάν θέλετε ναtarΓια να χρησιμοποιήσετε το λογισμικό το συντομότερο δυνατό, τότε μπορείτε:

Κάντε λήψη του λογισμικού τώρα

Διαφορετικά, αν θέλετε να κάνετε DIY, μπορείτε να διαβάσετε τα παρακάτω περιεχόμενα.

Ας προετοιμάσουμε το GUI

Το μόνο που χρειάζεστε είναι ένα μόνο φύλλο Excel και μπορείτε να ονομάσετε το φύλλο σύμφωνα με τις ανάγκες σας. Σε αυτό το παράδειγμα, χρησιμοποιώ το προεπιλεγμένο όνομα φύλλου "Sheet1". Το επόμενο βήμα είναι να προσθέσετε τις απαραίτητες κεφαλίδες σε αυτό το φύλλο. Ο μετατροπέας γεωγραφικού πλάτους και μήκους δίνει ακριβές αποτέλεσμα για τη διεύθυνση που περνάμε εάν η είσοδος περιλαμβάνει προάστιο, κατάσταση, σελostκωδικός και χώρα. Όπως φαίνεται στην εικόνα, προετοιμάστε κεφαλίδες. Ας προσθέσουμε το γεωγραφικό πλάτος και μήκος ως δύο τελευταίες στήλες. Χρειαζόμαστε επίσης ένα κουμπί για να επιτρέψουμε στον χρήστη να κάνει τη μετατροπή. Ας εισάγουμε λοιπόν ένα Σχήμα και γεμίστε το με χρώμα για να εμφανιστεί ως κουμπί.Προετοιμάστε το GUI

Ας το κάνουμε λειτουργικό

Το σενάριο που παρέχεται εδώ πρέπει να αντιγραφεί σε μια νέα ενότητα. Μην ξεχάσετε να αποθηκεύσετε το βιβλίο εργασίας σας ως αρχείο βιβλίου εργασίας με δυνατότητα μακροεντολής. Το Sub "FindThis" πρέπει να επισυνάπτεται στο κουμπί που μόλις δημιουργήσαμε.

Ας το δοκιμάσουμε

Προσθέστε διεύθυνση μαζί με άλλες πληροφορίες στις αντίστοιχες στήλες. Κάντε κλικ στο κουμπί για να εκτελέσετε τη μακροεντολή που θα εμφανίζει συντεταγμένες lat και long για όλες τις διευθύνσεις που αναφέρονται στο φύλλο. Η μακροεντολή θα είναι start στη σειρά 2 και θα συνεχίσει να τρέχει μέχρι να φτάσει σε μια κενή σειρά.Προσθήκη διεύθυνσης και κάντε κλικ στο κουμπί

Πως δουλεύει?

Με το σενάριο έχουμε δημιουργήσει δύο λειτουργίες. Ένα για ανάκτηση τιμής Lat και ένα άλλο για ανάκτησης Long value. Χρησιμοποιώντας ένα βρόχο 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., η οποία είναι ο παγκόσμιος ηγέτης στις τεχνολογίες ανάκτησης δεδομένων, συμπεριλαμβανομένων επισκευή doc πρόβλημα και προϊόντα λογισμικού αποκατάστασης προοπτικών. Για περισσότερες πληροφορίες επισκεφθείτε www.datanumen.com

Κοινή χρήση τώρα:

Τα σχόλια είναι κλειστά.