Entfernung zwischen zwei PLZ mit GoogleMaps berechnen!

[chris-ka]

Hallo Caprizio,

gleich mal wieder den Haken bei Visual Basic vertrauen entfernen und Makros brauchen auch keine aktiviert sein.
Die Datei ist komplett makrofrei!

Aber erst lauffähig ab der Version 2013.
Ich habe noch die Funktion URLCODIEREN eingebaut, obwohl bei mir Köln auch ohne diesen Zusatz funktioniert hat.


  Entfernung_googleMaps_ohne_VBA_ab_Excel2013.xlsx (Größe: 295,68 KB / Downloads: 738)
neue Version:
[img]
Dateiupload bitte im Forum! So geht es: Klick mich!
] (Größe: 295,68 KB / Downloads: 10)

p.s an die Moderatoren.
Wenn Ihr wollt könnt Ihr die Datei bei den Komplettlösungen hinterlegen. Die Datei sollte es in der Form noch nirgends im Netz geben!

Anbei noch der Vermerk von Google!
aus [/url]https://developers.google.com/maps/prici...ans/?hl=de
Kostenlos bis zu 2.500 Aufrufen pro Tag!

ACHTUNG! Ich habe einen Kunden der nur ein paar Adressen hatte, aber gleich mal ans Limit gekommen ist....
Da die Adressen manuell eingegeben worden sind und deswegen immer neu berechnet worden ist. Abhilfe war die automatische Berechnung auszuschalten und gezielt mit F9 zu aktualisieren. 

zu guter Letzt
hier noch die Nutzungsbedingungen von Google
https://developers.google.com/maps/terms?hl=de#4-provision-of-the-service-by-Google

lg
Chris

[Caprizio]

Ich bin nicht nur ein Dau und komplett unfähig..nein ich hab mich gestern selber shcon in den April geschickt.
Ich hatte irgendwie auf dem Schirm das ich 2013 über Ostern installiert hatte...aber nein...es war 2010 :05:

2013 drauf und alles läuft wie ein motor


vielen vielen vielen Dank !!

[baj19570]

Hey Leute,

ich brauch eure Hilfe und wär echt dankbar.

Es geht um folgendes:

Ich hab eine Liste von Adressen( Straße, PLZ, Ort) und möchte anhand dieser Infos eine Distanzmatrix( Entfernung zu sich selber und zu allen anderen Kunden) erstellen und mir die nötigen Infos wie km und Zeit aus google maps ziehen. Leider schaffe ich es nicht eine vollständige Distanzmatrix zu erstellen, sondern nur von einem Kunden zu allen anderen.

Kann mir jmd helfen?

Viele Grüße und Danke euch schon mal :)

[RPP63]

Hallo!
Hat ja eigentlich nichts mit dem Thema zu tun.
Eine Matrix aka Kreuztabelle erstellst Du prinzipiell so:

	A	B	C	D	E	F	G	H	I
1	Spalte/Zeile	A	B	C	D	E	F	G	H
2	A	|||	BA	CA	DA	EA	FA	GA	HA
3	B	AB	|||	CB	DB	EB	FB	GB	HB
4	C	AC	BC	|||	DC	EC	FC	GC	HC
5	D	AD	BD	CD	|||	ED	FD	GD	HD
6	E	AE	BE	CE	DE	|||	FE	GE	HE
7	F	AF	BF	CF	DF	EF	|||	GF	HF
8	G	AG	BG	CG	DG	EG	FG	|||	HG
9	H	AH	BH	CH	DH	EH	FH	GH	|||

Formeln der Tabelle

Zelle Formel B2 =WENN(B$1=$A2;"|||";B$1&$A2)

Bedingte Formatierungen der Tabelle

Zelle Nr.: / Bedingung Format B2 1. / Zellwert ist gleich ="|||" Abc

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Kannst Du dies mit den bekannten Formeln umsetzen?

Gruß Ralf

[baj19570]

Guten Morgen Ralf,

vielen Dank für deine schnelle Antwort.

Prinzipiell hat es schon was mit diesem Thema zu tun, da ich als Ausgangsdatei die google maps Abfrage von Schauan( Andre) verwendet habe. In dieser Datei werden leider nur die Distanzen von einer Startadresse zu allen anderen Adressen berechnet und ich benötige alle Distanzen zwischen allen Adressen. Ich möchte das in VBA umsetzen, da ich leider Anfänger bin klappt es nicht so ganz.

Viele Grüße und Danke dir für deine Hilfe 

[schauan]

Hallöchen,

da ich zu der Datei auch noch weitere codes gepostet habe, weiß ich jetzt nicht so genau, welchen Stand Du meinst. Die ursprüngliche Datei ist so aufgebaut, dass man den oberen Teil mit den Ausgangsadressen beliebig nach rechts erweitern kann. Dadurch könnte man die für die Matrix erforderlichen Berechnungen darüber laufen lassen und dann die Daten per Formel in die Kreuztabelle übernehmen.

Ich schaue aber noch, dass man die Daten direkt abrufen kann.

[schauan]

Hallöchen,

für die Kreuztabelle kannst Du folgenden code verwenden. Ich habe dabei Postleitzahlen ab Zelle A3 untereinander geschrieben und die Orte ab B3 (siehe gelb markierter Teil). Den Rest macht der code. Du brauchst also den waagerechten Teil usw. nicht einzugeben, es reicht die Liste in Spalte A und B. Wenn Du andere Spalten verwendest, müsstest Du nur die Startparameter im code für den "ersten Schnittpunkt" verändern.

Modul GoogleDirektKreuz

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: iCnt4 = 0 
'Daten transponieren 
'Daten kopieren 
Range(Cells(iCnt1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2)).Copy 
'Daten zwei Zeilen oberhalb erstem Schnittpunkt einfuegen 
Cells(iCnt2 - 2, iCnt2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True 
'Kopiermarkierung aus 
Application.CutCopyMode = False 
'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) <> "" 
      'OriginAddress ermitteln 
      'Hinweise: 
      'PLZ auch 4stellig moeglich 
      strOAddr = Format(.Offset(iCnt3, -2), "0####") & "," & ReplaceGermans(.Offset(iCnt3, -1)) 
      'Schleife ueber alle DestinationAddress 
      For iCnt4 = 1 To iCnt3 
        'DestinationAddress ermitteln 
        'Hinweise: 
        'PLZ nicht 4stellig moeglich! 
        strDAddr = Format(.Offset(-2, iCnt4 - 1), "0####") & "," & ReplaceGermans(.Offset(-1, iCnt4 - 1)) 
        '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 
        'Ende Schleife ueber alle DestinationAddress anhand Eintraegen in Spalte A 
      Next 
    '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 
 
 

Arbeitsblatt mit dem Namen 'Tabelle2'
	A	B	C	D	E	F
1			63739	63755	63768	7549
2			Aschaffenburg	Alzenau	Hösbach	Gera
3	63739	Aschaffenburg	x	29,148	5,007	340,668
4	63755	Alzenau	29,148	x	28,102	342,585
5	63768	Hösbach	5,007	28,102	x	338,091
6	7549	Gera	340,668	342,585	338,091	x

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

[Kozak]

Guten Tag,

kann man bei der Berechnung der KM und der Fahrzeit auch Filtern? Damit ist gemeint, dass Mautstraßen nicht berücksichtigt werden.


Vielen Dank im Voraus.

[schauan]

Hallöchen,

dafür gibt es avoid. Ist bei der Abfrage im Makro z.B. so einzusetzen:

'Abfrage oeffnen
objXML.Open "POST", "http://maps.googleapis.com/maps/api/distancematrix/xml?origins=" & strOAddr & "&destinations=" & strDAddr & "&language=de-DE&sensor=false avoid=tolls", False

[dasp88]

Hallo Caprizio,

gleich mal wieder den Haken bei Visual Basic vertrauen entfernen und Makros brauchen auch keine aktiviert sein.
Die Datei ist komplett makrofrei!

Aber erst lauffähig ab der Version 2013.
Ich habe noch die Funktion URLCODIEREN eingebaut, obwohl bei mir Köln auch ohne diesen Zusatz funktioniert hat.



p.s an die Moderatoren.
Wenn Ihr wollt könnt Ihr die Datei bei den Komplettlösungen hinterlegen. Die Datei sollte es in der Form noch nirgends im Netz geben!

Anbei noch der Vermerk von Google!
aus https://developers.google.com/maps/prici...ans/?hl=de
Kostenlos bis zu 2.500 Aufrufen pro Tag!

ACHTUNG! Ich habe einen Kunden der nur ein paar Adressen hatte, aber gleich mal ans Limit gekommen ist....
Da die Adressen manuell eingegeben worden sind und deswegen immer neu berechnet worden ist. Abhilfe war die automatische Berechnung auszuschalten und gezielt mit F9 zu aktualisieren. 

zu guter Letzt
hier noch die Nutzungsbedingungen von Google
https://developers.google.com/maps/terms?hl=de#4-provision-of-the-service-by-Google

lg
Chris

Habe mit der Tabelle einige Entfernungen berechnet, hat super funktioniert. Aber plötzlich klappt es nicht mehr, Entfernung ist immer "0". Liegt es vielleicht an Google-Beschränkungen und wie kann ich diese umgehen?