Registriert seit: 17.02.2017
Version(en): 2013
Hallo zusammen! Aufgrund der Umstellung bei Google wollte ich nachfragen, wie die Entfernungsberechnung mittels API-Key durchgeführt werden kann. Ich nutze unter folgendem abgeschlossenem Thema die Entfernungsberechnung von chris-ka mit Minutenausgabe (Beitrag #147). https://www.clever-excel-forum.de/thread...ge-15.htmlWäre es möglich die Formeln/Zelleninhalte entsprechend umzuschreiben, dass die Berechnung (mit dem API-Key) wieder ein Ergebnis liefert? Ist es möglich die Abfragen die bei Google getätigt wurden in einer Zelle anzugeben? Theoretisch hätte man ja so 10000 pro Monat frei bis erste Kosten anfallen würden. Wäre euch echt dankbar!!! Kennst sich auch schon jemand mit dem API-Key aus? Braucht man hierfür eine Kreditkartennummer oder reicht ein Konto bei Google? Habe hierzu folgenden Link gefunden. Von einer Kreditkarte ist hier zumindest nicht de Rede. https://praxistipps.chip.de/google-maps-...ehts_94915(sollte ich den Link einer externen Seite nicht darstellen dürfen bitte ich darum das er wieder gelöscht wird) Gruß Tobias
Registriert seit: 03.10.2018
Version(en): 2010 ProPlus / 2016 ProPlus
Hallo,
die Frage dürfte sich ganz schnell erledigt haben, nach der Google-Suche mit den Stichwörtern ...
"vba google api key entfernung berechnen"
Registriert seit: 17.02.2017
Version(en): 2013
15.01.2019, 08:58
Danke für die Antwort.
Ehrlich gesagt kann ich aber damit nichts anfangen.
Mit der Suche unter "clever-excel-forum" hab ich keine Lösung gefunden.
Mit der Suche unter "google" kommen zwar Lösungen aber ich kenne mich mit einzelnen Bausteinen nicht aus.
Desweiteren erscheinen weiter unten auf den anderen Seiten immer wieder Beiträge mit ABER... oder LEIDER FUNKTIONIERT IHR SYSTEM NICHT. Das könnte wohl heißen, dass die, die sich mit dem Thema auskennen und die angebotenen Bausteine umsetzen, trotzdem nicht ganz zufrieden sind damit.
Ich benötige eine fertig gestrickte Lösung. Dazu hätte ich als Grundmodul das von chris-ka im Beitrag #147 erarbeitete Tabellenblatt genannt.
Hierzu wär meine Frage ob dies jemand umstricken könnte auf den aktuell notwendige API-Key.
Es wäre doch auch in eurem Interesse eine perfekte Lösung auf eurer Seite zu präsentieren statt auf einzelne Bausteine auf andere Seiten zu verweisen...
Gruß
Tobias
Registriert seit: 21.12.2017
Version(en): MS 365 Family (6 User x 5 Geräte für jeden) Insider-Beta
(15.01.2019, 08:58)Drolln schrieb: Es wäre doch auch in eurem Interesse eine perfekte Lösung auf eurer Seite zu präsentieren statt auf einzelne Bausteine auf andere Seiten zu verweisen... Wo er recht hat, hat er recht. Das ist gefühlt die häufigste Anforderung der letzten 23,67 Jahre ;) Die alte Lösung von Opi bis vor API war auch komplett.
Registriert seit: 26.07.2017
Version(en): 365
Hallo zusammen, ich habe auch jahrelang mit "alten" Versionen aus diversen Foren gearbeitet, bis Google seine Richtlinien letztes Jahr geändert hat. Hier meine angepassten Funktionen, die bei mir mit meinem API-Schlüssel - vgl. Zeile 31: Code: Public Const GoogleAPIKey = "<API-KEY>" ' ← hier deinen API-Key eintragen!
- laufen. Das alles ist nicht auf meinem Mist gewachsen, daher bitte nicht erschlagen, wenn es nicht funktioniert. Über Erweiterungen, Korrekturen, Ergänzungen freue ich mich dann auch. Code: Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Sammlung von Funktionen für Google's Geocoding-API '
' original: http://oco-carbon.com/2012/03/29/google-maps-and-excel-download/ '
' '
' Folgende 6 Funktionen stehen zur Verfügung: '
' G_Adresse(Ortsangabe) : Adresse des übergebenen Ortes '
' G_LAT(Ortsangabe) : Latitude des übergebenen Ortes '
' G_LNG(Ortsangabe) : Longitude des übergebenen Ortes '
' G_LATLNG(Ortsangabe) : "Latitude, Longitude" des übergebenen Ortes '
' G_Dauer(Start, Ziel) : Dauer der Reise '
' G_Entfernung(Start, Ziel): Entfernung zwischen Start und Ziel '
' Parameter '
' Ortsangabe: Kann ein Ortsname, eine PLZ oder ein LAT/LNG-Paar sein '
' Requery : optionaler Parameter, um eine Nachschau über die API zu erzwingen ohne im Cache nachzusehen '
' Windows API call, um Excel zu einer bestimmten Ausführungspause (ms) zu zwingen '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#If VBA7 Then
' wenn 64bit-Version von Excel
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
' wenn 32bit-Version von Excel
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
' Konstante als Basis für Google API calls
Public Const WAIT_TIME = 50 ' Millisekunden
' Google-Maps API-Key (ab 08/2018 verpflichtend!) '
Public Const GoogleAPIKey = "<API-KEY>" ' ← hier deinen API-Key eintragen
Function G_Adresse(InputLocation As Variant, Optional Requery = False)
Dim Wait As Long
Wait = WAIT_TIME
' Beim ersten Aufruf nicht warten
G_Adresse = G_LATLNG(InputLocation, 4)
' Bei Verzögerungen Zeitintervall vergrößern
While (G_Adresse = "OVER_QUERY_LIMIT") And (Wait > 4000)
G_Adresse = G_LATLNG(InputLocation, 4, Wait)
Wait = Wait * 2
Wend
' wenn weiterhin Fehlermeldungen, dann ist das Limit der Anfragen für diese IP-Adresse für heute erreicht
If G_Adresse = "OVER_QUERY_LIMIT" Then
G_Adresse = "OVER_HARD_QUERY_LIMIT"
End If
End Function
Function G_LAT(InputLocation As Variant, Optional Requery = False)
' Gibt die Latitude einer Ortsangabe durch Googles Geocoding-API zurück
Dim Wait As Long
Wait = WAIT_TIME
' Beim ersten Aufruf nicht warten
G_LAT = G_LATLNG(InputLocation, 2)
' Bei Verzögerungen Zeitintervall vergrößern
While (G_LAT = "OVER_QUERY_LIMIT") And (Wait > 4000)
G_LAT = G_LATLNG(InputLocation, 2, Wait)
Wait = Wait * 2
Wend
' wenn weiterhin Fehlermeldungen, dann ist das Limit der Anfragen für diese IP-Adresse für heute erreicht
If G_LAT = "OVER_QUERY_LIMIT" Then
G_LAT = "OVER_HARD_QUERY_LIMIT"
End If
End Function
Function G_LNG(InputLocation As Variant, Optional Requery = False)
' Gibt die Longitude einer Ortsangabe durch Googles Geocoding-API zurück
Dim Wait As Long
Wait = WAIT_TIME
' Beim ersten Aufruf nicht warten
G_LNG = G_LATLNG(InputLocation, 3)
' Bei Verzögerungen Zeitintervall vergrößern
While (G_LNG = "OVER_QUERY_LIMIT") And (Wait > 4000)
G_LNG = G_LATLNG(InputLocation, 3, Wait)
Wait = Wait * 2
Wend
' wenn weiterhin Fehlermeldungen, dann ist das Limit der Anfragen für diese IP-Adresse für heute erreicht
If G_LNG = "OVER_QUERY_LIMIT" Then
G_LNG = "OVER_HARD_QUERY_LIMIT"
End If
End Function
Function G_LATLNG(InputLocation As Variant, Optional N As Long = 1, Optional Wait As Long, Optional Requery As Boolean = False) As Variant
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Vorbereitung: Referenz zu Microsoft XML, v6.0 erforderlich (vgl. VBA-Editor: "Extras - Verweise")! '
' Beschreibung: Der Parameter "N" gibt folgende Rückgabetypen an: '
' N = 1 -> gibt Latitude, Longitude als "string" '
' N = 2 -> gibt Latitude als "double" '
' N = 3 -> gibt Longitude als "double" '
' N = 4 -> gibt die Addresse als "string" '
' Update vom 30.10.12 '
' - gibt "#N/A error" zurück, wenn ein Fehler auftaucht '
' - Cache nur verwenden, wenn notwendig '
' - prüfen und versuchen, Fehler zu korrigieren '
' - funktioniert auf Systemen mit Komma als Dezimaltrenner '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim addressNode As IXMLDOMNode
Dim latNode As IXMLDOMNode
Dim lngNode As IXMLDOMNode
Dim statusNode As IXMLDOMNode
Dim CachedFile As String
Dim NoCache As Boolean
Dim V() As String ' im original als "Variant"
On Error GoTo exitRoute
G_LATLNG = CVErr(xlErrNA) ' gibt "#N/A Fehler" im Falle irgendeines Fehlers
ReDim V(1 To 4)
' Prüfen und Eingabe löschen
If WorksheetFunction.IsNumber(InputLocation) Or IsEmpty(InputLocation) Or InputLocation = "" Then GoTo exitRoute
Sleep (Wait)
InputLocation = URLEncode(CStr(InputLocation), True)
' Prüfe, ob eine "gecachte" Datei existiert
CachedFile = Environ("temp") & "\" & InputLocation & "_LatLng.xml"
NoCache = (Len(Dir(CachedFile)) = 0)
Set myRequest = New XMLHTTP60
If NoCache Or Requery Then ' wenn kein Cache oder wenn Anfrage an Google erzwungen, dann Google fragen
Sleep (Wait)
' XML-Daten von Google Maps API auslesen
' Alte Version bis 07/2018:
' myRequest.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?address=" & InputLocation & "&sensor=false", False
' Neue Version ab 08/2018:
myRequest.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml" & _
"?address=" & InputLocation & _
"&key=" & GoogleAPIKey & _
"&sensor=false", False
myRequest.Send
' XML lesbar machen durch "XPath"
Set myDomDoc = New DOMDocument60
myDomDoc.LoadXML myRequest.responseText
Else ' ansonsten Anfrage im Cache recherchieren
myRequest.Open "GET", CachedFile
myRequest.Send
' XML lesbar machen durch "XPath"
Set myDomDoc = New DOMDocument60
myDomDoc.LoadXML myRequest.responseText
' Prüfe den Status-Code der gecachten XLM-Datei (bei früheren Fehlern)
Set statusNode = myDomDoc.SelectSingleNode("//status")
If statusNode Is Nothing Then ' eine fehlerhafte Datei wurde möglicherweise gecached
G_LATLNG = G_LATLNG(InputLocation, N, True) ' rekursiv untersuchen, um Fehler zu finden
Exit Function
ElseIf statusNode.Text <> "OK" Then ' eine Datei ohne Resultat wurde gecached
G_LATLNG = G_LATLNG(InputLocation, N, True) ' rekursiv versuchen, Fehler zu löschen
Exit Function
End If
End If
Set statusNode = myDomDoc.SelectSingleNode("//status")
If statusNode.Text = "OK" Then
Set addressNode = myDomDoc.SelectSingleNode("//result/formatted_address") ' Örtlichkeit holen
Set latNode = myDomDoc.SelectSingleNode("//result/geometry/location/lat") ' Latitude holen
Set lngNode = myDomDoc.SelectSingleNode("//result/geometry/location/lng") ' Longitude holen
V(1) = latNode.Text & "," & lngNode.Text
V(2) = latNode.Text ' im original als double: V(2) = Val(latNode.Text)
V(3) = lngNode.Text ' im original als double: V(3) = Val(lngNode.Text)
V(4) = addressNode.Text
G_LATLNG = V(N)
If NoCache Then ' cache API-Antwort, falls erforderlich
Call CreateFile(CachedFile, myRequest.responseText)
End If
Else
G_LATLNG = statusNode.Text
End If
exitRoute:
Set addressNode = Nothing
Set statusNode = Nothing
Set latNode = Nothing
Set lngNode = Nothing
Set myDomDoc = Nothing
Set myRequest = Nothing
End Function
Function G_Entfernung(Origin As String, Destination As String, Optional Requery As Boolean = False) As Variant
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Vorbereitung: Referenz zu Microsoft XML, v6.0 erforderlich (vgl. VBA-Editor: "Extras - Verweise")! '
' Beschreibung: Berechnet die Entfernung (km) zwischen "Origin" und "Destination" '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim distanceNode As IXMLDOMNode
Dim statusNode As IXMLDOMNode
Dim CachedFile As String
Dim NoCache As Boolean
On Error GoTo exitRoute
G_Entfernung = CVErr(xlErrNA) ' gibt "#N/A-Fehler" bei irgendeinem Fehler zurück
' Prüfen, ob Start/Ziel existieren
If WorksheetFunction.IsNumber(Origin) Or IsEmpty(Origin) Or Origin = "" Then GoTo exitRoute
If WorksheetFunction.IsNumber(Destination) Or IsEmpty(Destination) Or Destination = "" Then GoTo exitRoute
' Start/Ziel "URL-lesbar" machen
Origin = URLEncode(CStr(Origin), True)
Destination = URLEncode(CStr(Destination), True)
' Prüfe, ob es eine gecachete Version gibt
CachedFile = Environ("temp") & "\" & Origin & "_" & Destination & "_Dist.xml"
NoCache = (Len(Dir(CachedFile)) = 0)
Set myRequest = New XMLHTTP60
If NoCache Or Requery Then ' wenn keine gecachete Version existiert, Anfrage an Google
' Alte Version bis 07/2018:
' myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" & Origin & "&destination=" & Destination & "&sensor=false", False
' Neue Version ab 08/2018:
myRequest.Open "GET", "https://maps.googleapis.com/maps/api/directions/xml" & _
"?origin=" & Origin & _
"&destination=" & Destination & _
"&key=" & GoogleAPIKey & _
"&sensor=false", False
myRequest.Send
Else ' sonst lese die Anfrage aus der Temp-Datei
myRequest.Open "GET", CachedFile
myRequest.Send
Set myDomDoc = New DOMDocument60
myDomDoc.LoadXML myRequest.responseText
Set statusNode = myDomDoc.SelectSingleNode("//status")
If Not statusNode.Text = "OK" Then
Call G_Entfernung(Origin, Destination, True) ' rekursiv versuchen, Fehler zu löschen
End If
End If
' Macht die XML lesbar mittels XPath
Set myDomDoc = New DOMDocument60
myDomDoc.LoadXML myRequest.responseText
Set statusNode = myDomDoc.SelectSingleNode("//status")
If statusNode.Text = "OK" Then
If NoCache Then
Call CreateFile(CachedFile, myRequest.responseText) ' API cachen, wenn erforderlich
End If
Set distanceNode = myDomDoc.SelectSingleNode("//leg/distance/value") ' Entfernung holen
If Not distanceNode Is Nothing Then
G_Entfernung = Val(distanceNode.Text) / 1000
End If
Else
G_Entfernung = statusNode.Text
End If
exitRoute:
Set statusNode = Nothing
Set statusNode = Nothing
Set distanceNode = Nothing
Set myDomDoc = Nothing
Set myRequest = Nothing
End Function
Function G_Dauer(Origin As String, Destination As String, Optional Requery As Boolean = False) As Variant
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Vorbereitung: Referenz zu Microsoft XML, v6.0 erforderlich (vgl. VBA-Editor: "Extras - Verweise")! '
' Beschreibung: Berechnet die Auto-Fahrzeit (hh:mm) für die Strecke zwischen "Origin" und "Destination" '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim durationNode As IXMLDOMNode
Dim statusNode As IXMLDOMNode
Dim CachedFile As String
Dim NoCache As Boolean
On Error GoTo exitRoute
G_Dauer = CVErr(xlErrNA) ' gibt "#N/A-Fehler" bei irgendeinem Fehler zurück
' Prüfen, ob Start/Ziel existieren
If WorksheetFunction.IsNumber(Origin) Or IsEmpty(Origin) Or Origin = "" Then GoTo exitRoute
If WorksheetFunction.IsNumber(Destination) Or IsEmpty(Destination) Or Destination = "" Then GoTo exitRoute
' Start/Ziel "URL-lesbar" machen
Origin = ConvertAccent(URLEncode(CStr(Origin), True))
Destination = ConvertAccent(URLEncode(CStr(Destination), True))
' Prüfe, ob es eine gecachete Version gibt
CachedFile = Environ("temp") & "\" & Origin & "_" & Destination & "_Dist.xml"
NoCache = (Len(Dir(CachedFile)) = 0)
Set myRequest = New XMLHTTP60
If NoCache Or Requery Then ' wenn keine gecachete Version existiert, Anfrage an Google
' Alte Version bis 07/2018:
' myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" & Origin & "&destination=" & Destination & "&sensor=false", False
' Neue Version ab 08/2018:
myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml" & _
"?origin=" & Origin & _
"&destination=" & Destination & _
"&key=" & GoogleAPIKey & _
"&sensor=false", False
myRequest.Send
Else ' sonst lese die Anfrage aus der Temp-Datei
myRequest.Open "GET", CachedFile
myRequest.Send
Set myDomDoc = New DOMDocument60
myDomDoc.LoadXML myRequest.responseText
Set statusNode = myDomDoc.SelectSingleNode("//status")
If Not statusNode.Text = "OK" Then
Call G_Dauer(Origin, Destination, True) ' rekursiv versuchen, Fehler zu löschen
End If
End If
' Macht die XML lesbar mittels XPath
Set myDomDoc = New DOMDocument60
myDomDoc.LoadXML myRequest.responseText
Set statusNode = myDomDoc.SelectSingleNode("//status")
If statusNode.Text = "OK" Then
If NoCache Then
Call CreateFile(CachedFile, myRequest.responseText) ' API cachen, wenn erforderlich
End If
Set durationNode = myDomDoc.SelectSingleNode("//leg/duration/value") ' Reisedauer holen
If Not durationNode Is Nothing Then
G_Dauer = Val(durationNode.Text) / 86400 ' im original stand hier "1000" (???)
End If
End If
exitRoute:
Set statusNode = Nothing
Set durationNode = Nothing
Set myDomDoc = Nothing
Set myRequest = Nothing
End Function
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long
Dim i As Long
Dim CharCode As Integer
Dim Char As String
Dim Space As String
StringVal = ConvertAccent(StringVal)
StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Space = IIf(SpaceAsPlus, "+", "%20")
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 45, 46, 48 To 57, 61, 65 To 90, 95, 97 To 122, 123, 125, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next
URLEncode = Join(result, "")
End If
End Function
Function ConvertAccent(ByVal inputString As String) As String
' Code originally from Rick Rothstein, posted on
' http://www.jpsoftwaretech.com/remove-and-replace-special-characters-in-vba/
' Handling of German characters contributed by Gabor
Dim x As Long
Dim Position As Long
Const AccChars As String = "ߊŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåç©èéêëìíîïðñòóôõößùúûüýÿ©"
Const RegChars As String = "sSZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaacceeeeiiiidnooooosuuuuyyc"
Const DeAccChars As String = "ÄÖÜäöü"
For x = 1 To Len(inputString)
Position = InStr(AccChars, Mid(inputString, x, 1))
If Position Then
If InStr("ß", Mid(inputString, x, 1)) Then
inputString = Left(inputString, x) & "s" & Right(inputString, Len(inputString) - x)
End If
If InStr(DeAccChars, Mid(inputString, x, 1)) Then
inputString = Left(inputString, x) & "e" & Right(inputString, Len(inputString) - x)
End If
Mid(inputString, x) = Mid(RegChars, Position, 1)
End If
Next
ConvertAccent = inputString
End Function
Function CreateFile(FileName As String, Contents As String) As String
' Neue Datei erzeugen und Inhalt speichern
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
With fsT
.Type = 2 ' Streamtype ermitteln: text/string data speichern
.Charset = "utf-8" ' Charset UTF-8 für die Quelltexte
.Open ' Stream öffnen und Binärdaten schreiben
.WriteText Contents ' Textdaten schreiben
.SaveToFile FileName, 2 ' Binärdaten speichern
End With
Set fsT = Nothing
End Function
Sub DeleteFile(ByVal FileToDelete As String)
' Datei löschen
If FileOrDirExists(FileToDelete) Then
SetAttr FileToDelete, vbNormal
Kill FileToDelete
End If
End Sub
Function FileOrDirExists(PathName As String) As Boolean
' Hinweis: gibt WAHR zurück, wenn Datei oder Pfad existiert, sonst FALSCH
Dim iTemp As Integer
On Error Resume Next
iTemp = GetAttr(PathName)
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
On Error GoTo 0
End Function
Viel Erfolg.
Herzliche Grüße aus dem Rheinland
Jörg
[Windows 10, Microsoft 365]
Registriert seit: 17.02.2017
Version(en): 2013
Hallo, Danke für deine Antwort LuckyJoe. Dein Ergebnis scheint wohl mit VBA gelöst zu werden. Damit kenne ich mich lieder noch weniger aus. Die von chris-ka erarbeitete Exceltabelle funktioniert ohne VBA sondern nur mit Formeln. Ist es auch hier möglich zu einem Ergebnis zu kommen mittels API Key? Ich hänge die chris-ka erstellte Exceltabelle die ich leicht umgewandelt habe mal als Anlage mit herein.
Entfernungsberechnung ohne Adressen.xlsx (Größe: 26,13 KB / Downloads: 169)
Als Adressen habe ich Regierungssitze angegeben. Auf der Seite "Entf. Baustelle" würde die Luflinie und Fahrtstrecke zwischen Berlin und München angegeben werden. Auf der Seite "Entf. Schüttgt" würde die Fahrtstrecke zwischen München und den umliegenden Landratsämtern angegeben werden. Tatsächlich wäre natürlich Berlin mein Firmensitz, München eine Baustelle, und die Landtratsämter wären Schüttgut- oder Betonlieferanten. Vielleicht kann man auf dieser Grundlage was erstellen. Wie gesagt. Ich kann wenn es funktioniert Werte eingeben. Hab aber NULL AHNUNG was die Formel die mir das Ergebnis liefert macht. Gruß Tobias
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo Tobias, für Entwicklung / Umsetzung und Test einer Formellösung mit API-Key bräuchten wir einen interessierten mit Key  Ich kann lediglich auf einen recht ausführlichen Beitrag im Netz verweisen, vielleicht hilft Dir der weiter: https://chandoo.org/wp/distance-between-...-maps-api/
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 17.02.2017
Version(en): 2013
Hallo,
hab jetzt nicht genau verstanden wie du das meinst.
Ich denke aber dass du mit "...einen interessierten mit Key..." ein Excelexperte meinst, der mit seinem Key das Tabellenblatt umschreiben würde und dann mit dem Hinweis "hier deinen Key eintragen" dieses Tabellenblatt wieder zur Verfügung stellen würde.
Vielleicht findet sich ja jemand.
Ich kann leider einen/meinen Key nicht an einen Dritten weitergeben.
Gruß
Tobias
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo Tobias, wenn Du einen Key hast, kannst Du Dir dort die Beispieldatei herunterladen und schauen, wie es damit geht. Für Deine Datei - das Blatt Schüttgut - sollte es so funktionieren. Die Zelle D1 habe ich gmaps.key genannt. | Arbeitsblatt mit dem Namen 'Entf. Schüttgut' | | C | D | E | | 1 | API-Key: | ABCDEFG | | | 2 | | | | | 3 | | | | | 4 | | | | | 5 | Hilfe | Spalte3 | Spalte2 | | 6 | <?xml version="1.0" encoding="UTF-8"?>
<DistanceMatrixResponse>
<status>REQUEST_DENIED</status>
<error_message>The provided API key is invalid.</error_message>
</DistanceMatrixResponse>
| <?xml version="1.0" encoding="UTF-8"?>
<GeocodeResponse>
<status>REQUEST_DENIED</status>
<error_message>The provided API key is invalid.</error_message>
</GeocodeResponse>
| <?xml version="1.0" encoding="UTF-8"?>
<GeocodeResponse>
<status>REQUEST_DENIED</status>
<error_message>The provided API key is invalid.</error_message>
</GeocodeResponse>
|
| Zelle | Formel | | C6 | =WEBDIENST("https://maps.googleapis.com/maps/api/distancematrix/xml?origins="&URLCODIEREN(A6)&"&destinations="&URLCODIEREN(B6)&";&key=" & gmaps.key&"&mode="&$Y$6&"&units=metric"&"&language=de") | | D6 | =WEBDIENST("https://maps.googleapis.com/maps/api/geocode/xml?address="&URLCODIEREN([@Baustelle])&";&key=" & gmaps.key) | | E6 | =WEBDIENST("https://maps.googleapis.com/maps/api/geocode/xml?address="&URLCODIEREN([@Landratsamt])&";&key=" & gmaps.key) |
| Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016 | | Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg |
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:1 Nutzer sagt Danke an schauan für diesen Beitrag 28
• Drolln
Registriert seit: 17.02.2017
Version(en): 2013
Hallo André, hallo zusammen, kann mir noch jemand sagen welcher KEY (ODER welche KEYS möglich wären da nicht alle kostenfrei) für diese Anwendung notwendig ist. Laut unserem Ersteller für die Website gibt es verschiedene Keys von Google für unterschiedliche Anwendungen. Mit Excel kennt er sich leider nicht so aus. Einen Key könnte er mir aber generieren. Hier die verschiedenen Möglichkeiten die er mir aufgezeigt hat:
Gruß Tobias
|
