Hallo, 

man kann sich bei google anmelden und einen Schlüssel für die Google Matrix API bekommen. Dieser wird (seit dem 22.Juni 2016) benötigt um die API von google zu verwenden. Da hat man am Tag 2500 Berechnungen frei und weitere Berechnungen muss man für wenig Geld einkaufen.

1. Bei Google Anmelden https://console.developers.google.com 

2. Über die Bibliothek das  "Google Maps Distance Matrix API" aktivieren.

3. Über die Zugangsdaten einen neuen Schlüssel erstellen 

4. Unten stehenden Code in Excel Makro einsetzen

5. Den Eintrag "MEIN SCHLÜSSEL" durch den eigenen Schlüssel ersetzen

6. Die Funktion in Excel mit =distanz(A2;B2) ausführen. In dem Fall ist die Zeile A2 die Abfahrt-Adresse und B2 das Ziel.

Public Function distanz _
( _
start As String, _
ziel As String _
)

Dim surl                As String
Dim oXH                 As Object
Dim bodytxt             As String
Dim distanc_e           As String

'Umlauten umwandeln
start = Replace(start, " ", "+")
start = Replace(start, "ß", "ss")
start = Replace(start, "ä", "ae")
start = Replace(start, "ü", "ue")
start = Replace(start, "ö", "oe")
start = Replace(start, "Ö", "Oe")
start = Replace(start, "Ä", "Ae")
start = Replace(start, "Ü", "Ue")
ziel = Replace(ziel, " ", "+")
ziel = Replace(ziel, "ß", "ss")
ziel = Replace(ziel, "ä", "ae")
ziel = Replace(ziel, "ü", "ue")
ziel = Replace(ziel, "ö", "oe")
ziel = Replace(ziel, "Ö", "Oe")
ziel = Replace(ziel, "Ä", "Ae")
ziel = Replace(ziel, "Ü", "Ue")
'Umlauten umwandeln - ENDE


'URL Aufruf
surl = "https://maps.googleapis.com/maps/api/distancematrix/xml" & _
"?origins=" & start & _
"&destinations=" & ziel & _
"&mode=driving&sensor=false&units=metric&key=MEINSCHLÜSSEL"
'URL Aufruf Ende


'Ausgabe
Set oXH = CreateObject("msxml2.xmlhttp")
    With oXH
        .Open "get", surl, False
        .send
        bodytxt = .responseText
    End With
    bodytxt = Right(bodytxt, Len(bodytxt) - InStr(1, bodytxt, "<text>") - 5)
    tim_e = Left(bodytxt, InStr(1, bodytxt, "</text>") - 1)

    bodytxt = Right(bodytxt, Len(bodytxt) - InStr(1, bodytxt, "<text>") - 5)
    distanc_e = Left(bodytxt, InStr(1, bodytxt, "</text>") - 1)

    distanz = distanc_e


Set oXH = Nothing

End Function