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-0e41OBauHTIrFGJnqCgEHIgd82O_XXXXXX"

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./