Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

[D] Luftlinie.org-Entfernungstool volti
#1
https://www.clever-excel-forum.de/Thread...#pid204903

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
 With tDist
  .Start = "Frankfurt": .Ziel = "München"
  GetDistance tDist
  MsgBox "Die Entfernung zwischen" & vbCrLf _
      & .Start & vbCrLf & "und" & vbCrLf _
      & .Ziel & vbCrLf & "beträgt " & .LDist & " km." & vbCrLf _
      & "Die Fahrstrecke beträgt " & .FDist & "!", vbInformation, "Entfernung ermitteln"
 End With
End Sub

Sub GetDistance(tDist As DIST_STRUCT)
 Dim oNode As Object
 With CreateObject("InternetExplorer.Application")
  .navigate "http://www.luftlinie.org"      'Zur Url surfen
  While Not .readyState = 4: DoEvents: Wend 'Warten bis Seite geladen ist

  With .document
   Set oN‌ode = .getElementById("start")
   If Not oNode Is Nothing Then
    oNode.value = tDist.Start
    Set oN‌ode = .getElementById("end")
    On Error Resume Next
    If Not oNode Is Nothing Then
      oNode.value = tDist.Ziel
      Set oN‌ode = .getElementById("calcDistance")
      If Not oNode Is Nothing Then oNode.Click
      Do
        Sleep 100
        Set oN‌ode = Nothing
        Set oN‌ode = .getElementById("strck")
        If Not oNode Is Nothing Then
          If Not oNode.outerText Like "*--*" Then Exit Do
        End If
        DoEvents
      Loop
      tDist.LDist = .getElementsByClassName("value km")(0).outerText
      tDist.FDist = .getElementById("strck").outerText
      tDist.Start = tDist.Start & " " & .getElementsByClassName("regions")(0).outerText
      tDist.Ziel = tDist.Ziel & " " & .getElementsByClassName("regions")(2).outerText
    End If      'End
   End If      'Start
  End With
  .Quit        'IE schließen
 End With
End Sub

____________________________________________________________
Als Tabellenfunktion mit dynamischer Breite (ab xl2013, wenn als Array abgeschlossen; sonst ab xl365), ersetzt die gleichnamige Sub oben:

Function EntfernungErmitteln(a, b)
Dim tDist As DIST_STRUCT
With tDist
  .Start = a: .Ziel = b
  GetDistance tDist
  EntfernungErmitteln = Replace(.Start, " ", "_") & " " & Replace(.Ziel, " ", "_") & " " & .LDist & " " & .FDist
End With
End Function

Stehen in A1:B1 Start und Ziel, resultieren in C1:F1: StartGenau, ZielGenau, Luftlinie, Entfernung:

C1: =MTRANS(XMLFILTERN(WECHSELN("<a><b>"&WECHSELN(EntfernungErmitteln(A1;B1);" km";)&"</b></a>";" ";"</b><b>");"//b"))

Will man nur letztere beide Zahlen haben, dann:

C1: =INDEX(MTRANS(XMLFILTERN(WECHSELN("<a><b>"&WECHSELN(EntfernungErmitteln(A1;B1);" km";)&"</b></a>";" ";"</b><b>");"//b"));{3.4})
Antwortento top


Nachrichten in diesem Thema
[D] Luftlinie.org-Entfernungstool volti - von LCohen - 27.07.2020, 18:39

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste