Entfernung in Excel berechnen

In diesem Artikel wird gezeigt, wie Sie Bing Maps verwenden, um die Entfernung zwischen zwei Punkten in einer Tabelle zu berechnen.

Wenn Sie es eilig haben, können Sie die Arbeitsmappe herunterladen und schnell die Entfernung zwischen zwei Adressen bestimmen, indem Sie ihre Adressen in eine Excel-Tabelle eingeben. Klicken Sie hier, um den Entfernungsrechner herunterzuladen.

API Schlüssel für Bing Maps generieren

Wir müssen zuerst Ihren Bing Maps-API-Schlüssel abrufen, um diesen später im Code verwenden zu können.

Befolgen Sie die Schritte hier, um einen Schlüssel zu erstellen.

VBA Excel-Code für die Berechnung der Entfernung

Um den Visual Basic-Editor in Excel zu öffnen, drücken Sie ALT + F11 (halten Sie die ALT-Taste gedrückt und drücken Sie die Taste F11). Dadurch wird ein separates Fenster für den Visual Basic-Editor geöffnet.

Klicken Sie im Visual Basic-Editor auf Einfügen > Modul

Kopieren Sie nun den gesamten Code unten und fügen Sie ihn in Module1 in Ihrer Arbeitsmappe ein.

Public Function GetDistance(start As String, dest As String)
    
    Dim myKey As String: myKey = "Ah3Mmh_97J4MSsHof-0e41OBauHTIrrGJnqCgEHIgd82O_sOlzGhB1ugP0oXXXXX"
    
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & start & "&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    
    If InStr(objHTTP.responseText, "coordinates") = 0 Then GoTo ErrorHandl
    
    
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "(?=.*)\\[([0-9]+.[0-9]+,[0-9]+.[0-9]+)\\]": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    coordinates1 = matches(0).SubMatches(0)
    \'MsgBox coordinates1
    objHTTP.Open "GET", "http://dev.virtualearth.net/REST/v1/Locations?q=" & dest & "&key=" & myKey, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    
    If InStr(objHTTP.responseText, "coordinates") = 0 Then GoTo ErrorHandl
    
    
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "(?=.*)\\[([0-9]+.[0-9]+,[0-9]+.[0-9]+)\\]": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    coordinates2 = matches(0).SubMatches(0)
    \'MsgBox coordinates2
    objHTTP.Open "GET", "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins=" & coordinates1 & "&destinations=" & coordinates2 & "&travelMode=driving&distanceUnit=km&output=json&key=" & myKey, False
    \'Sheets(1).Cells(1, 1).Value = "https://dev.virtualearth.net/REST/v1/Routes/DistanceMatrix?origins=" & coordinates1 & "&destinations=" & coordinates2 & "&travelMode=driving&distanceUnit=km&output=json&key=YOUR_KEY"
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    
    
    If InStr(objHTTP.responseText, "travelDistance") = 0 Then GoTo ErrorHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "([0-9]+\\.[0-9]+)": regex.Global = True
    Set matches = regex.Execute(objHTTP.responseText)
    msg = ""
    
    
    For Each t In matches
        msg = msg & t & vbCrLf
    Next
    \'MsgBox msg
    
        GetDistance = matches(4)
    Exit Function
ErrorHandl:
    MsgBox (objHTTP.responseText), vbCritical, "ERROR"
    GetDistance1 = -1
    
End Function

 

Jetzt müssen Sie „Ah3Mmh_97J4MSsHof-0e41OBauHTIrrGJnqCgEHIgd82O_slzGhB1ugP0oXXXXX“ durch Ihren Bing Maps API-Schlüssel ersetzen.

Versuchen Sie, in Ihrer Tabelle zwei Standorte wie Embrach und Elgg anzugeben. Berechnen Sie nun die Entfernung zwischen den beiden Orten mit der Funktion GetDistance.

Sie können auf Bing Maps überprüfen, ob das Ergebnis dasselbe ist.

Benötigen Sie einen VBA Programmierer?

Wir als exact construct programmieren mit einem Team von rd. 20 Mitarbeitern seit über 10 Jahren Excel-Tools. Wir sind ein Nischenanbieter der spezialisiert auf Makros/VBA-Codes ist. Daneben unterstützen wir auch als 3rd Level Support die IT-Abteilungen rund um Probleme bei MS Office (Excel, Word, PowerPoint, etc.).

Haben Sie ein Excel-Problem? Benötigen Sie einen Makro-Programmierer? Rufen Sie uns unverbindlich an +41 52 511 05 25 oder kontaktieren Sie uns via Kontaktformular./