Bing Entfernungsrechner / Fahrzeit

[wisch]

Hallo André,

das habe ich, wenn es nicht deutlich genug rüber kam, bereits im #16 zum Ausdruck bringen wollen.

[schauan]

Hi wisch,

ja, hast Du. Aber irgendwie hat mich Deine Antwort 18 wohl zu meiner Antwort motiviert...

[el_gor]

Hallo und herzlichen Dank für die vielen Rückmeldungen ...

ich bin über die Anzahl der vielen Abfragen auch verwundert gewesen aber vermutlich hängt es mit dem VBA-Script zusammen (siehe ganz zu Beginn des Beitrages).

Public Function GetDistance(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="  ..................


Ich bin leider nicht sehr versiert in VBA ... vermutlich lag es daran dass dies als "Function" definiert war ... darf ich nun bitten: Wie müsste das angepasst werden, damit nicht jedesmal Abfragen stattfinden?

Danke und lieben Gruß, Elmar

[schauan]

Hallöchen,

wenn es die vom Anfang des Threads sind dann wäre das auch korrekt, ansonsten erhältst Du ja kein Ergebnis, siehe am Ende:

GetDistance = CDbl(tmpVal)
Exit Function
ErrorHandl:
GetDistance = -1
End Function

An den Funktionen an sich solltest Du auch nix ändern sondern unsere Hinweise aus 16-19 beachten ... Hast Du denn die schon mal in Erwägung gezogen?

Einen Code dafür bekommt man auch mit Aufzeichnen hin. Wenn Du z.B. die Daten auf Knopfdruck oder Wechsel der Zelle berechnen und die Formeln durch die Ergebnisse ersetzen willst könnte das so aussehen

--> Cursor in die gewünschte Zelle setzen
--> im Click-Makro:
ActiveCell.Formula="DeineFormel"
ActiveCell.Offset(0,1)="DeineAndereFormel"
ActiveCell.Value=ActiveCell.Value
ActiveCell.Offset(0,1).Value=ActiveCell.Offset(0,1).Value

Bei einem Makro bei Wechsel der Zelle müsste man noch zusätzlich prüfen, ob man in der richtigen Spalte (oder Zeile) ist und das nicht zu viele Zellen gewählt wurden

[wisch]

Zuerst einmal: lastVal = "mein API-Key"

zumindest bei mir läut es nur bei Eingabe von: lastval= "&key=mein API-Key".

Dann, damit ich nicht bei allen Makros, die evtl. einen API-Key enthalten, denn ich vor Versendung der Mappe entfernen muss, habe ich diese(n) in der personl.xlsx abgelegt, die ja (normalerweise) immer ausgeblendet geöffnet ist.

Dieser wird mit folgender Routine ausgelesen:

Code:

Sub get_API_key(wk_API_key)

Dim Dateiname As String ' der Name der (geschlossenen) Mappe incl. Pfad
Dim WkBk As Workbook ' das ausgewählte Object - die zu durchsuchende Mappe

Dateiname = Application.StartupPath & "\personl.xlsx"

'  Mit GetObject(Dateiname) wird die Mappe quasi unsichtbar geöffnet.
'  Dies ist daran zu erkennen, da das Ereignis WORKBOOK_OPEN prozessiert wird.
'  Siehe auch: http://www.ms-office-forum.net/forum/showthread.php?t=225566

Set WkBk = GetObject(Dateiname)    'Auch notwendig, wenn bereits offen
wk_API_key = WkBk.Worksheets("Tabelle1").Range("API_key").Value

End Sub

Durch diese Maßnahme wird somit der/die persönliche(n) API-key(s), deren misbräuchliche Nutzung ja Geld kosten kann, niemals sichtbar !!! Sofern es noch bessere Methoden gibt, API-Keys zu schützen, bin ich für jede Anregung dankbar !!!

Als nächstes habe ich die Ermittlung von Zeit und Strecke zusammengefasst. Somit reduziert sich die Anzahl der Aufrufe direkt um 50%. Per einfacher Formeln (Links und Rechts oder TEIL) kannst du die Ergebnisse teilen. Dabei habe ich auch eine Routine zur Bearbeitung der Umlaute eingefügt.

Code:

Public Function GetDistance_and_duration(start As String, dest As String)
    Dim firstVal As String, secondVal As String, lastVal As String, _
          wk_distance As String, wk_duration As String

    firstVal = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    secondVal = "+&destinations="

'API_key ermitteln
    Call get_API_key(lastVal)

    start = ReplaceUmlaute(start)
    dest = ReplaceUmlaute(dest)

    Url = firstVal & Replace(start, " ", "+") & _
          secondVal & Replace(dest, " ", "+") & _
          "&key=" & lastVal

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    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
    End If

    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
    wk_distance = CDbl(tmpVal)

    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = "duration(?:.|\n)*?""value"".*?([0-9]+)": regex.Global = False
    Set matches = regex.Execute(objHTTP.responseText)
    tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))

    wk_duration = CDbl(tmpVal)
    GetDistance_and_duration = wk_distance & " | " & wk_duration

    Exit Function

ErrorHandl:
    GetDistance_and_duration = -1

End Function

Hier noch die Routine zum Auflösen der Umlaute:

Code:

Function ReplaceUmlaute(ByVal strText As String) As String

'Funktion ersetzt deutsche Umlaute
'Variablendeklaration
'Integer

Dim iCnt%

Dim arrRep
'Array mit Umlauten und Replacements definieren

arrRep = Array("Ö", "Oe", "ö", "oe", "Ä", "Ae", "ä", "ae", "Ü", "Ue", "ü", "ue", "ß", "ss")

'Schleife von 0 bis Ende vom Array, Schrittweite 2

For iCnt = 0 To UBound(arrRep) Step 2
  'Umlaut mit Replacement ersetzen
  strText = Replace(strText, arrRep(iCnt), arrRep(iCnt + 1))
'Ende Schleife von 0 bis Ende vom Array, Schrittweite 2
Next

ReplaceUmlaute = strText

End Function

Noch besser ist allerdings, wie bereits erwähnt, die Ermittlung von Fahrzeiten/Strecken durch ein normales Makro erledigen zu lassen, bei dem du einen Loop über dien Tabelle durchführst, und nur für die Zeilen die Berechnungen durchführst, für die bisher noch keine Fahrzeiten und Strecken ermittelt wurden.

Bei sehr umfangreichen Tests, habe ich in den vergangenen 3 Tagen, mein Kontingent gerade einmal mit 97 Abfragen belastet.

Nachtrag: Habe nun schon 3 Mal die vbielen unnötigen Leezeilen gelöscht, die kommen aber immer wieder rein! Keine Ahnung warum !!!

[LCohen]

Du musst den anderen Editor nehmen - in den 6 Minuten, die Dir noch bleiben.

[wisch]

Deine Nachricht habe ich zu spät gesehen. Macht aber nichts, da nun die vielen Leerezeilen nicht mehr erscheinen.

[LuckyJoe]

Hallo zusammen,

bei einem der aktuellen Themen bin ich wieder hier gelandet und habe mir die Lösung(en) noch einmal genauer angeschaut, das sie wesentlich kürzer sind als Lösungen über die Google-Api. So ganz steige ich zwar noch nicht durch die Formel durch, aber habe zumindest herausgefunden, dass der letzte Wert in den eckigen Klammern {4} die Fahrstrecke bedeutet, die {3} die (Luftlinien-) Entfernung, die {2} das Ziel, die {1} den Start.

Gibt es auch eine Formel, um die Fahrzeit zu der Fahrstrecke zu berechnen (bei Google gibt es dazu ja auch noch das Verkehrsmittel als Parameter) und idealerweise Längen-/Breitengrad von Start/Ziel?

Vielen Dank im Voraus.