Entfernung zwischen zwei PLZ mit GoogleMaps berechnen!

[dominik.lichtmess]

Hi ich bin neu hier und finde diese Funktion einfach klasse.
 
Wollte mal fragen, ob man das Modul GoogleTest2 auch so umschreiben kann, dass man nicht Google maps sondern ADAC maps nutzen kann?
Wenn dies gehen würde wäre die nächste Frage ob man die Abfrage so eingrenzen könnte, dass immer nur die kürzeste Route genommen wir?
 
Ich hoffe Ihr könnt mir helfen. 

[schauan]

Hallöchen dominik,

wenn überhaupt, wird das nicht so einfach sein. Bei Google gibt es eine ausführliche Beschreibung, die Abfrage ist z.B. recht einfach per Link zu gestalten usw. Das geht beim ADAC so nicht. Man müsste die Site analysieren, schauen, über welche Elemente Ein- und Ausgaben erfolgen usw. Da müsste man viel Zeit mitbringen

Hallo Thunderstrik,

Du hattest aber geschrieben, dass Du die Daten reinkopieren willst und nicht auf andere Zellen verweisen Wo klemmt's denn bei den Verweisen?

[dominik.lichtmess]

Hi André

vielen Dank für die schnelle Antwort. Hab mir schon fast gedacht, dass das nicht so einfach geht. Wie schaut es da bei google oder falk aus?
kann ich da einstellen, dass ich immer die kürzeste Route bekomme? 

Leider gibt mir das ApBetrO nicht die Möglichkeit die schnellste Route zu wählen. Es muss leider immer die kürzeste Route sein.  

LG

Dominik

[WillWissen]

Hi Dominik,

ich persönlich halte die Routenplaner, egal, wie sie heißen, nur für bedingt tauglich. Google maps ist nicht einstellbar, Falk hingegen schon. Aber beide sind in meinen Augen auf keinen Fall streckenaktuell. Ich mache das an einer bestimmten Strecke fest, die ich jahrzehntelang mindestens 20 mal im Jahr gefahren bin. Die kürzeste Entfernung (ganz normale Bundes- bzw. Staatsstraßen, gut ausgebaut) beträgt definitiv 61 km. Tante Google hingegen meint, mich auf einen Umweg mit 22 km schicken zu müssen; Falk kommt trotz Einstellung "nur kürzeste Strecke" immerhin noch auf 20 km Umweg. Schalte ich hingegen mein Navi ein und verlange die kürzeste Strecke, findet dieses sogar noch einen (allerdings nicht empfehlenswerten) Schleichweg, der mir die Strecke um etwa 1,2 km kürzt.

[schauan]

Hallo Günter,
Da es in der Frage um den vom ADAC ging wäre es schön zu wissen, ob der auch so weit daneben liegt :-S

[WillWissen]

Hi André,

Hallo Günter,
Da es in der Frage um den vom ADAC ging wäre es schön zu wissen, ob der auch so weit daneben liegt :-S

das hatte ich überlesen (war nur auf den letzten Beitrag fixiert). ADAC maps ist einstellbar (schnellste bzw. kürzeste Route) und hat - zumindest bei meiner vorhin angegebenen Teststrecke - diese korrekt berechnet.

[dominik.lichtmess]

Hi,

daher nehmen wir ja auch in der Regel ADAC. Aber das konnten wir ja schon klären, dass das nicht geht.
Bei Falk währe es zumindest so, dass dieser Routenplaner bei uns akzeptiert wird. Aber wenn es nicht geht muss
ich halt weiter die Messungen per Hand machen.

Aber vielen Dank Ihr seit echt klasse.  :19:  :100:

[jochen-glaser]

Hallo zusammen,

erstmal danke für die vielen Hinweise. Ich habe eine Liste mit allen PLZ aus Deutschland. Der User wird zur Eingabe seiner PLZ aufgefordert. Im Anschluss soll die Entfernung seiner PLZ zu jeder PLZ in der Liste (ca. 14000 Stück) berechnet werden. Habe dafür den Code in ne Schleife gepackt. Leider bricht er nach ner Zeit mit dem Fehler 91 ab. Das hängt wohl damit zusammen, dass Google dicht macht. Gibt es dafür eine Lösung? Wenn ich die Datei neu aifmache, läuft die Abfrage erstmal wieder. Eine Idee wäre daher vielleicht, die Datei per Makro zu schließen, wieder zu öffnen und anschließend die Schleifer wieder an der letzten Stelle zu starten. Habe es noch nicht ausprobiert. Wollte erstmal euer Feedback abwarten. Besten Dank im Voraus.


Sub Entfernung_berechnen_Abfrage()
    Dim PLZ As String
   
    PLZ = InputBox("Bitte geben Sie die Ihre Postleitzahl ein.", "eigene Postleitzahl")
   
    Suche1 = PLZ
   
    Set Zelle1 = Columns().Find(What:=Suche1, LookIn:=xlValues, LookAt:=xlWhole)
    If Zelle1 Is Nothing Then
    GoTo Abbruch
   
    Else
    MsgBox "Die Entfernungsberechnung für knapp 14.000 Postleitzahlen wird jetzt gestartet. Beachten Sie bitte, dass dies einige Zeit in Anspruch nehmen wird. Sie bekommen eine Meldung, sobald alles abgeschlossen ist."
   
    Call Entfernung_berechnen
    End If
Abbruch:
    MsgBox "Geben Sie eine korrekte Potleitzahl ein"
    Call Entfernung_berechnen_Abfrage
   
End Sub
   
Sub Entfernung_berechnen()
   
    ActiveSheet.Unprotect "A$mu$$3n"
   
    Cells(1142, 1).Select
    For i = ActiveCell.Row To 13406
    'Variablendeklarastionen
    'Objekt - Late Binding
    Dim objXML As Object 'fuer XML-"String"
    Dim xmlDoc As Object
    Dim xmlNod As Object
   
    'String
    Dim strOAddr$, strDAddr
    On Error GoTo errorhandler
   
    'XML-Objecte instanzieren
    Set objXML = CreateObject("Msxml2.XMLHTTP")
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
   
    'Wenn Instanzierung nicht nichts gebracht hat, dann
    If Not objXML Is Nothing Then
     
    'OriginAddress ermitteln
    'Hinweise:
    'PLZ auch 4stellig moeglich
    strOAddr = "Deutschland, " & Format(PLZ, "0####")
    
    'DestinationAddress ermitteln
    'Hinweise:
    'PLZ nicht 4stellig moeglich!
    strDAddr = "Deutschland, " & Format(Cells(i, 1), "0####")
     
    'Abfrage oeffnen
    objXML.Open "POST", "http://maps.googleapis.com/maps/api/dist...ml?origins=" & strOAddr & "&destinations=" & strDAddr & "&language=de-DE&sensor=false", False
     
    'Abfrageheader
    objXML.setRequestHeader "Content-Type", "content=text/html; charset=UTF-8"
     
    'Abfrage senden
    objXML.send
     
    'Abfrageergebnis (Text) aufnehmen
    xmlDoc.LoadXML objXML.responseText
     
    'Entfernung auslesen /Value=Meter /Text = Kilometer mit Angabe "km"
    Set xmlNod = xmlDoc.SelectSingleNode("//row/element/distance/value")
     
    'Entfernung in km zelle eintragen, Rueckgabewert / 1000
    Cells(i, 4) = xmlNod.Text / 1000
     
    'Ende Wenn Instanzierung nicht nichts gebracht hat, dann
    End If
   
    'Fehlerbehandlung / Programmende
errorhandler:
   
    'Wenn Fehlernummer <> 0, dann Ausgabe Fehlermeldung
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
    If Err.Number <> 0 Then Call Entfernung_berechnen
   
    'XML-Objecte zuruecksetzen
    Set xmlNod = Nothing
    Set xmlDoc = Nothing
    Set objXML = Nothing
   
    Next i
       
    ActiveSheet.Protect "A$mu$$3n"
       
    MsgBox "Die Berechnung ist abgeschlossen!"
       
End Sub

[schauan]

Hallöchen,

für professionelle abfragen solltest Du Dir einen Key von Google beschaffen.

[jochen-glaser]

Danke für die Info. Wusste nicht, dass dies dann als prfessionelle Abfrage gilt.

Ich hab allerdings überhaupt keinen Plan, wohin ich mich da wende. Vielleicht hast du da auch noch nen Tip für mich, wo ich den bekomme, und wie ich den dann einbinde.
Danke.