Office: (Office 2010) Auswertung Anfahrtszeiten öffentlich vs. Auto mittels Google Maps

Hallo zusammen,

ich kenne mich überhaupt nicht mit Makros aus, deshalb frage ich euch. Ich habe nun 2 Tage lang das Internet durchforstet, aber nichts passendes gefunden, bzw. auch nicht richtig verstanden.

Folgendes: Ich habe ca. 100 Privatadressen und die Adresse von unserem Standort.
Ich benötige nun eine Auswertung, wie lange diese Personen mit dem Auto und mit den öffentlichen brauchen würden.

Quasi so:
Name, Anschrift, Standort, Auto in Min., ÖPNV in Min.


Funktioniert so etwas überhaupt?

Liebe Grüße**

 

Hola,

wenn du eine kostenpflichtige API von Google kaufst, sollte das gehen.

https://praxistipps.chip.de/google-maps-api-das-sind-die-kosten_96360

Gruß,
steve1da

 

Für die Routenberechnung (Distanz und Dauer) entstehen bis zu ca.40000 Abrufen(so ungefähr habe ich das noch im Kopf)
keine Kosten. Dennoch ist eine Kreditkarte für die Erstellung einer DevelopmentId erforderlich. Sollten mehr Abrufe anfallen,
wird nicht automatisch auf ein kostenpflichtiges Level geupgradet (es sei denn, man wählt das vorher aus).

https://developers.google.com/maps/documentation/javascript/get-api-key

Hier kannst du dir deinen DeveloperKey erstellen.

danach in Excel auf den Reiter Entwicklertools gehen (sollte er nicht vorhanden sein, unter Excel/Datei/Optionen/Menüband Entwicklertools anklicken) und dort VisualBasic anklicken.

Dort mit der rechten Maustaste auf Module klicken und Einfügen-> Modul klicken.
Dort folgende Funktionen einkopieren:

Code:

Public Function GetDistance(ByVal start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "&destinations="
    lastVal = "&mode=car&language=de&sensor=false&key=[COLOR="#FF0000"]GoogleKey[/COLOR]
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    If InStr(objHTTP.responsetext, """distance"" : {") = 0 Then GoTo ErrorHandl
    Set Regex = CreateObject("VBScript.RegExp"): Regex.Pattern = """value"".*?([0-9]+)": Regex.Global = False
    Set matches = Regex.Execute(objHTTP.responsetext)
    tmpval = Replace(matches(Index).SubMatches(0), ".", Application.International(xlListSeparator))
    GetDistance = CDbl(tmpval)/1000
    Exit Function
ErrorHandl:
    GetDistance = -1
End Function

Code:

Public Function GetDuration(ByVal start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String
    firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "&destinations="
    lastVal = "&mode=car&language=de&sensor=false&key=[COLOR="#FF0000"]GoogleKey[/COLOR]
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
    objHTTP.Open "GET", URL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ("")
    If InStr(objHTTP.responsetext, """duration"" : {") = 0 Then GoTo ErrorHandl
    Set Regex = CreateObject("VBScript.RegExp"): Regex.Pattern = "duration(?:.|\n)*?""value"".*?([0-9]+)": Regex.Global = False
    Set matches = Regex.Execute(objHTTP.responsetext)
    tmpval = Replace(matches(Index).SubMatches(0), ".", Application.International(xlListSeparator))
    GetDuration = CDbl(tmpval)/864000
    Exit Function
ErrorHandl:
    GetDuration = -1
End Function

GoogleKey (rot geschrieben) durch deinen Key ersetzen...


in deiner Tabelle dann

Spalte A1: Startadresse
Spalte A2: Zieladresse

für die Entfernung:
Spalte A5: =GetDistance(A1;A2)

für die Zeit Feld als Uhrzeit formatieren:
Spalte A6: =GetDuration(A1;A2)

Entfernung und Zeit wird für Auto berechnet