Entfernungen Berechnen

[schauan]

Hallo Fennek,

Das gleiche denke ich auch, jedoch ist es der Firma zu teuer

Hallo MarvMarv,

wenn es nicht zu viele Abfragen sind kostet es der Firma nix, schaue mal bei Google zu den Preislisten ...

[MarvMarv2906]

Wie sieht es denn mit Luftlinie.Org aus?
Anders als es der Name vermuten lässt, handelt es sich ja um einen vollwertigen Routenplaner.

Ich schaue mir das über die Feiertage mal genauer an.

Gruß Ralf

Guten Morgen Ralf, ich hoffe doch das die Feiertage entspannt waren. Hattest du Zeit und Lust dir das anzusehen? 

Ich selbst habe es auch noch einmal paar mal probiert, bin jedoch gescheitert


Grüße Marvin

---

Moin, ich hoffe auch du hattest schöne Festtage, 

es variiert es kann auch auch sein, dass es sehr viele sind, grade jetzt zu der Zeit Planen wir das gesamte Jahr und da wird für jeden Tag des Jahres eine Berechnung (für alle MA) durchgeführt.

[MarvMarv2906]

Hallo zusammen, 

ich sitze immer noch verzweifelt an dem Ding. 


Kann mir bitte jemand Helfen? 

[RPP63]

Ich weiß ehrlich gesagt nicht, wo Dein Problem liegt.
Folgende Datei (Luftlinie.org) funktioniert einwandfrei:
https://www.clever-excel-forum.de/attach...?aid=33218

Ist von hier:
https://www.clever-excel-forum.de/Thread...#pid204922

Gruß Ralf

[MarvMarv2906]

Ich weiß ehrlich gesagt nicht, wo Dein Problem liegt.
Folgende Datei (Luftlinie.org) funktioniert einwandfrei:
https://www.clever-excel-forum.de/attach...?aid=33218

Ist von hier:
https://www.clever-excel-forum.de/Thread...#pid204922

Gruß Ralf

Okay...ich bin dezent sprachlos... Die Datei ist super! ich hatte sie nicht am richtigen "Ort" gespeichert und daher hat das Makro nicht funktioniert.
Das was jetzt noch wäre, die Datei vergleicht wie in dem Thread beschrieben nur Strecke A zu B und B zu C etc. also fortlaufend. Was ich benötige wäre A zu B und A zu C etc. 

Immer wenn ich das in der Formel ändern will kommt #Wert als Fehler.

[schauan]

Hallöchen,

hast Du auch beachtet, dass es sich um Array-Formeln handelt?

[Woofer]

allo  zusammen,

vielen Dank, für diesen wertvollen Post, nach 6 Stunden Suche, endlich mal etwas was funktioniert.

Gibt es noch eine Möglichkeit, einzustellen, dass immer der kürzeste Weg genommen wird? 
Mit Google Maps gibt es eine Route, die ist 3 min langsamer aber über 20km kürzer. Ich glaube für meine Steuererklärung benötige ich die kürzeste Route.
Luftline.org gibt mir in Excel 73.98km zurück. 5km weniger als bei Google, jedoch eben nicht die kürzeste, die liegt bei 56,2km
Gibt es da noch ein paar Stellschrauben in der VBA?

Da das Bild nicht angezeigt wird hier die Testadressen:
Start: Trelleborgerstr. 37 13189 Berlin
Ziel :Behnitzer Dorfstr. 27-31 14641 Nauen

(Die Adressen sind  nur ein Beispiel, ich wohne da nicht)

Nachtrag: Ich möchte an die Hundert Wege berechnen lassen, immer von einem Start Punkt. Wenn Ich die neu Excel öffne, sind die Ergebnis Felder immer leer und es wird alles neu berechnet. Kann man das verhindern, weil es eigentlich unnötig ist. Werte stehen ja schon drin.



 


 

Vielen Dank
Klaus

[volti]

Hallo,

bzgl. des Nachtrags:

Man kann das, wie ich das ursprünglich auch vorgesehen hatte, in einer VBA-Schleife ohne Formeln abholen.
Und in diesem Zusammenhang testen, ob schon eine Strecke drin steht.

Hier mal ein Muster dazu und nur von einem Start zu verschiedenen Zielen, wobei ich jetzt die etwas kürzere Get-Methode über die Url gewählt habe. Sollte auch ein wenig schneller sein.

Probiere es halt mal aus. Stellschrauben für weitere Optionen sind mir jetzt nicht bekannt, hatte aber auch nur wenig damit rumprobiert.

Code:

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Type DIST_STRUCT
     Start As String ' Mehrere durch "/" getrennt eingeben
     Ziel  As String
     LDist As String
     FDist As String
End Type

Sub EntfernungErmitteln()
  Dim tDist As DIST_STRUCT, iZeile As Long

  With tDist
      Application.StatusBar = ""
      .Start = Range("A1").Value
      For iZeile = 2 To Cells(Rows.Count, "A").End(xlUp).Row
          If Cells(iZeile, "B").Value = "" Then
             .Ziel = Cells(iZeile, "A").Value
             Application.StatusBar = "Strecke " & .Start & " nach " & .Ziel & " wird ermittelt"
             GetDistance tDist
             DoEvents
             Cells(iZeile, "B").Value = .FDist
          End If
      Next iZeile
  End With
  MsgBox "Fertig!", vbInformation, "Strecken ermitteln"
End Sub

Sub GetDistance(tDist As DIST_STRUCT)
' Get-Methode
  Dim oDoc As Object, i As Integer

  With CreateObject("InternetExplorer.Application")
      .Navigate "http://www.luftlinie.org/" _
      & tDist.Start & "/" & tDist.Ziel          ' Zur Url surfen
      While Not .readyState = 4: DoEvents: Wend ' Warten bis Seite geladen ist
      On Error Resume Next
      Set oDoc = .Document
      With tDist
          If Not .Start Like "#####*" Then .Start = ""
          If Not .Ziel Like "#####*" Then .Ziel = ""
          Do
             Sleep 100: i = i + 1
             .FDist = oDoc.getElementById("strck").outertext
             If Not .FDist Like "*--*" Then Exit Do
             If i > 50 Then Exit Do
          Loop
          .LDist = oDoc.getElementsByClassName("value km")(0).outertext
          .Start = Trim$(.Start & " " & oDoc.getElementsByClassName("regions")(0).outertext)
          .Ziel = Trim$(.Ziel & " " & oDoc.getElementsByClassName("regions")(2).outertext)
      End With
      .Quit                                    ' IE schließen
  End With
End Sub

_________
viele Grüße
Karl-Heinz

[schauan]

Hallöchen,

für die Steuererklärung kann man auch die schnellste nehmen. Allerdings ist das wohl Ermessensfrage. Man sollte in eine Begründung auch solche Sachen wie z.B. den Berufsverkehr bei der Dauer erwähnen.

Auf jeden Fall muss es keine Luftlinie sein, oder nutzt Du schon einer Personendrohne?

@Karl-Heinz, InternetExplorer.Application ist wohl in absehbarer Zeit nicht mehr Lauffähig. Microsoft entfernt den IE aus W10 ...

[volti]

Hallo Andre,

ja es ist traurig, wenn liebgewonnene Dinge einfach ohne Grund nicht mehr funktionieren.
Es ist zum...

Bis dahin jedoch eine kleine Erweiterung um Zeiten (wer's brauchen kann)
Dank an Sabina.

Code:

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Type DIST_STRUCT
     Start As String ' Mehrere durch "/" getrennt eingeben
     Ziel  As String
     LDist As String
     FDist As String
     LTime As String
     FTime As String
End Type

Sub EntfernungErmitteln()
  Dim tDist As DIST_STRUCT, iZeile As Long

  With tDist
      Application.StatusBar = ""
      .Start = Range("A1").Value
      For iZeile = 2 To Cells(Rows.Count, "A").End(xlUp).Row
          If Cells(iZeile, "B").Value = "" Then
             .Ziel = Cells(iZeile, "A").Value
             Application.StatusBar = "Strecke " & .Start & " nach " & .Ziel & " wird ermittelt"
             GetDistance tDist
             DoEvents
             Cells(iZeile, "B").Value = .FDist
             Cells(iZeile, "C").Value = .FTime
          End If
      Next iZeile
  End With
  MsgBox "Fertig!", vbInformation, "Strecken ermitteln"
End Sub

Sub GetDistance(tDist As DIST_STRUCT)
' Get-Methode
  Dim oDoc As Object, i As Integer

  With CreateObject("InternetExplorer.Application")
      .Navigate "http://www.luftlinie.org/" _
      & tDist.Start & "/" & tDist.Ziel          ' Zur Url surfen
      While Not .readyState = 4: DoEvents: Wend ' Warten bis Seite geladen ist
      On Error Resume Next
      Set oDoc = .Document
      With tDist
          If Not .Start Like "#####*" Then .Start = ""
          If Not .Ziel Like "#####*" Then .Ziel = ""
          Do
             Sleep 100: i = i + 1
             .FDist = oDoc.getElementById("strck").outertext
             If Not .FDist Like "*--*" Then Exit Do
             If i > 50 Then Exit Do
          Loop
          .LDist = oDoc.getElementsByClassName("value km")(0).outertext
          .LTime = oDoc.getElementsByClassName("directionsResultTime0")(0).outertext
          .FTime = oDoc.getElementsByClassName("directionsResultTimeTotal")(0).outertext
          .Start = Trim$(.Start & " " & oDoc.getElementsByClassName("regions")(0).outertext)
          .Ziel = Trim$(.Ziel & " " & oDoc.getElementsByClassName("regions")(2).outertext)
      End With
      .Quit                                    ' IE schließen
  End With
End Sub

_________
viele Grüße
Karl-Heinz