Entfernung zwischen zwei PLZ mit GoogleMaps berechnen!

[schauan]

Hallöchen,

anbei habe ich noch einen Code, um eine kreuzgefährliche kreuztabellenähnliche Tabelle zu füllen. Voraussetzung ist diesmal, dass sowohl waagerecht als auch senkrecht die Ortsdaten eingetragen werden. Der Code befüllt dann zeilenweise die Tabelle.

Da hier die Eintragungen nicht mehr wie in der Kreuztabelle um die Diagonale "gespiegelt" werden, fällt auf, dass anscheinend gleiche Strecken unterschiedliche Längen aufweisen. Ich habe das heute mit Aschaffenburg und Alzenau geprüft. Google Maps gibt mir zwischen Alzenau nach Aschaffenburg zwei Angebote aus mit 30 km und 27,7 km. In die Tabelle wurden vom Code die 30 km übernommen - etwas genauer als der auf eine Stelle gerundete Wert zur Anzeige in Google Maps.
Für den Rückweg von Aschaffenburg nach Alzenau erhalte ich sogar 3 Vorschläge, 31,4 km, 27,8 km und über Land mit nur 19,8 km. Übernommen wurde hier auch wieder der erste Wert mit 31,4 km.

Hier mal die Tabelle:

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C	D	E
1			63739	63755	7549
2			Aschaffenburg	Alzenau	Gera
3	63739	Aschaffenburg	x	31,351	341,099
4	63755	Alzenau	29,982	x	342,167
5	63768	Hösbach	10,291	35,776	338,347
6	99084	Erfurt	282,347	260,289	96,662
7	7743	Jena	321,402	299,343	59,367

Diese Tabelle wurde mit Tab2Html (v2.5.0) erstellt. ©Gerd alias Bamberg

PHP-Code:

Option Explicit
 
Public Sub GoogleTest2()
'Variablendeklarastionen
'Objekt - Late Binding
Dim objXML As Object 'fuer XML-"String"
Dim xmlDoc As Object
Dim xmlNod As Object
'Objekt - Early Binding
    'Dim xmlDoc As New MSXML2.DOMDocument
    'Dim xmlNod As MSXML2.IXMLDOMNode
'String
Dim strOAddr$, strDAddr
'Integer
Dim iCnt1%, iCnt2%, iCnt3%, iCnt4%
On Error GoTo errorhandler
'Flackern aus
Application.ScreenUpdating = False
'Zeile und Spalte fuer Start Kreuztabelle (erster Schnittpunkt)
'Hinweis: PLZ zwei Spalten links daneben bzw. zwei Zeilen oberhalb
'Hinweis: Ort eine Spalte links daneben bzw. eine Zeile oberhalb
'Hinweis: kleinste Werte daher jeweils 3!
iCnt1 = 3: iCnt2 = 3
'Offsetzaehler: Hilfszaeheler fuer letzte Eintragung einer Zeile
iCnt3 = 0
'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
With Cells(iCnt1, iCnt2)
  'Schleife ueber alle OriginAddress anhand Eintraegen in Spalte A + B
  'Tue solange Zellinhalt Spalte A nicht leer
  Do While .Offset(iCnt3, -2) <> ""
      iCnt4 = 1
      'OriginAddress ermitteln
      'Hinweise:
      'PLZ auch 4stellig moeglich
      strOAddr = Format(.Offset(iCnt3, -2), "0####") & "," & ReplaceGermans(.Offset(iCnt3, -1))
      'Schleife ueber alle DestinationAddress
      Do While .Offset(-2, iCnt4 - 1).Value <> ""
        'DestinationAddress ermitteln
        'Hinweise:
        'PLZ nicht 4stellig moeglich!
        strDAddr = Format(.Offset(-2, iCnt4 - 1), "0####") & "," & ReplaceGermans(.Offset(-1, iCnt4 - 1))
        'Wenn Zieladresse <> Startadresse, dann
        If strOAddr <> strDAddr Then
        'Abfrage oeffnen
        objXML.Open "POST", "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & strOAddr & ",germany&&destinations=" & strDAddr & ",germany&&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
        .Offset(iCnt3, iCnt4 - 1) = xmlNod.Text / 1000
        '.Offset(iCnt4 - 1, iCnt3) = xmlNod.Text / 1000
        'Alternativ zu Wenn Zieladresse <> Startadresse
        Else
          .Offset(iCnt3, iCnt4 - 1) = "x"
        'Ende Wenn Zieladresse <> Startadresse, dann
        End If
        iCnt4 = iCnt4 + 1
      'Ende Schleife ueber alle DestinationAddress anhand Eintraegen in Spalte A
      Loop
    'x eintragen
    '.Offset(iCnt3, iCnt3) = "x"
    'Endzaehler hochsetzen
    iCnt3 = iCnt3 + 1
  'Ende Tue solange Zellinhalt nicht leer
  Loop
End With
'Ende Wenn Instanzierung nicht nichts gebracht hat, dann
End If
'Fehlerbehandlung / Programmende
errorhandler:
'Flackern ein
Application.ScreenUpdating = True
'Wenn Fehlernummer <> 0, dann Ausgabe Fehlermeldung
If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
'XML-Objecte zuruecksetzen
Set xmlNod = Nothing
Set xmlDoc = Nothing
Set objXML = Nothing
End Sub
 
Function ReplaceGermans(ByVal strText As String) As String
'Funktion ersetzt deutsche Umlaute
'Variablendeklaration
'Integer
Dim iCnt%
'Array
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
'ReplaceGermans = strText
ReplaceGermans = strText
End Function 


[chris-ka]

Hallo,

da ich eine Anfrage bekommen habe ob es auch möglich ist per Formel die Luftlinie auszurechnen....
;)

  Entfernung_googleMaps_ohne_VBA_ab_Excel2013_V4_inklusive_Luftlinie.xlsx (Größe: 17,85 KB / Downloads: 255)

[Drolln]

Vielen Dank für die prompte Beantwortung und Bearbeitung. :23: :23: :23:

Gruß
Tobias

[bendrdiss]

Hallo Community,

ich bin neu hier im Forum. Ich bin über Google auf der Forum gestoßen. Leider habe ich keine Kenntnisse zu Excel. Doch möchte ich die Entfernung zwischen zwei PLZ in Excel berechnen. Die hier vorgestellten Versionen funktionieren bei mir nicht. Muss ich etwas bei den Einstellungen beachten.

Vielen Dank!

[chris-ka]

Hi,

Version 2011... bei Mac geht meine Datei sicherlich nicht!
Ist nur in der Win Version ab 2013 lauffähig

[DbSam]

Die hier vorgestellten Versionen funktionieren bei mir nicht.

Hallo,

diese hier sollte schon mit Deiner Version funktionieren.
Trage einfach etwas ein oder aktualisiere die Start- Zielfelder mit F2


Gruß Carsten

[chris-ka]

Hi,

über PN wurde gefragt ob die Dauer auch in Minuten möglich wäre
anbei die Datei dazu

  Entfernung_googleMaps_ohne_VBA_ab_Excel2013_V4_inklusive_Luftlinie_Dauer in Min.xlsx (Größe: 17,14 KB / Downloads: 134)

[mrthiemann]

Hallo Community!

Ich möchte mich hier dann auch mal dazugesellen =)

Ich erstelle gerade eine Nachkalkulation für meine Aufträge. Neben wirklich vielen, vielen Abfragen würde ich auch gerne meine durchschnittlichen Spritkosten der einzelnen Fahrzeuge errechnen.
Hierfür brauche ich natürlich die Distanz vom Standort zum Kunden.

Nach kurzer Suche im Netz bin ich auf die Datei von DbSam gestoßen (Entfernungen Google Maps_V2.xlsm) (-->#34)

Da ich aber nicht, wie gehabt, alles in verschiedenen Tabellen errechnen möchte, bin ich gerade dabei alles in einer einzigen zu packen.
Hier stoße aber ich aber manches mal an meine Grenzen...

In dem Klassenmodul "clsGMaps" gibt es folgenden

Code:

Private Function GetXmlText(ByVal xmlDoc As DOMDocument60, ByVal myNodeString As String) As String

In meiner Tabelle wird mir allerdings folgender Fehler ausgestoßen, wenn ich die Zeile anklicke:

Fehler beim Kompilieren:

Benutzerdefiniterter Typ nicht definiert

Leider komme ich hier seit Tagen absolut nicht weiter. Kann mir vielleicht jemand behilflich sein ?


Schöne Grüße

[DbSam]

Hallo Mr. Thiemann,

vermutlich hast Du diesen Hinweis überlesen:

Code:

'Hinweis:
'Beim Kopieren in ein neues Projekt muss ein Verweis auf "MicrosoftXML, V#.##" gesetzt werden.

Gruß Carsten

PS:
Schau nochmal weiter, da müsste hier noch eine V3 herum schwirren ...
Hier ist die V3

[mrthiemann]

Hy,

naja den Hinweis habe ich wohl eher ignoriert, als übersehen.
Ich weiß leider nicht, was ich damit anfangen soll.

Danke für den Link auf die V3. An der werde ich mich nun versuchen...

Wenn mir dann noch gesagt werden könnte, wie ich das mit dem Verweis anstellen muss, dann ist auch meine Ostern gerettet =)



Schöne Grüße
Karsten