Excel VBA Makro macht nicht was es soll...

[_Funkiwi_]

Huhus, ich muss zugeben, ich habe so ziemlich gar keine Ahnung von VBA. Ich will Excel dafür excel benutzen.
Ich will für meine Bachelorarbeit die Entfernung von vielen Einsatzorten zu einem Basisstandort berechnen. Da der Weg mit dem Auto zurückgelegt werden wird, brauche ich eine Route bzw. einen Routenplaner.

ich habe im Netz gesucht und ein recht brauchbaren ansatz gefunden:

Option Explicit
Sub Orte()
Dim i As Integer
Dim zeile As Long
With Sheets(1)
zeile = .Range("A65536").End(xlUp).Row
For i = 3 To zeile
.Cells(i, 4).Value = Entfernung(.Cells(2, 1), .Cells(2, 2), .Cells(2, 3), .Cells(i, 1), .Cells(i, 2), .Cells(i, 3))
Next i
End With

End Sub



Function Entfernung(Von_Straße As String, Von_PLZ As String, Von_Ort As String, Nach_Straße As String, Nach_PLZ As String, Nach_Ort As String)
Dim IEApp As Object
Dim IEDocument As Object
Dim blnGefunden As Boolean
Dim RouteStr As String
Dim Von As String
Dim Nach As String
' Dim Von_PLZ As String
' Dim Nach_PLZ As String
' Dim Von_Ort As String
' Dim Nach_Ort As String
' Dim Von_Straße As String
' Dim Nach_Straße As String
Dim IEDoc As Object
Dim strTeile As Variant
Dim i As Long
Dim msg As String

blnGefunden = False
' Von_PLZ = ""
' Von_Ort = "Frankfurt"
' Von_Straße = ""
' Nach_PLZ = ""
' Nach_Ort = "Köln"
' Nach_Straße = ""
Von = Adresse(Von_Straße, Von_Ort, Von_PLZ)
Nach = Adresse(Nach_Straße, Nach_Ort, Nach_PLZ)
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = False
IEApp.Navigate "http://maps.google.com/maps?saddr=" & Von & "&daddr=" & Nach & "&hl=de"
Do: Loop Until IEApp.Busy = False
Set IEDocument = IEApp.Document
Set IEDoc = IEApp.Document
Do: Loop Until IEApp.Busy = False
strTeile = Split(IEDoc.Body.innerText, vbCrLf)
'Debug.Print IEDoc.Body.innerText
For i = LBound(strTeile) To UBound(strTeile)
If InStr(1, strTeile(i), "Minuten", vbTextCompare) > 0 Then
'If IsNumeric(Left(strTeile(i), 1)) = True Then
blnGefunden = True
Entfernung = "Von: " & Von & vbLf & "Nach: " & Nach & vbLf & strTeile(i)
'msg = msg & strTeile(i) & vbNewLine
End If
Next
If blnGefunden = False Then
MsgBox "Die Adresse konnte nicht decodiert werden." & vbCr & "Falsche PLZ?"
Else
' msg = "Von: " & Von & vbNewLine & "Nach: " & Nach & vbNewLine & msg
' Entfernung = msg
'MsgBox msg

End If
IEApp.Quit
Set IEDocument = Nothing
Set IEApp = Nothing
End Function

Function Adresse(Street As String, City As String, ZIP As String) As String
Dim HStr As String

If Street <> "" Then HStr = Street & ","
If ZIP <> "" Then HStr = HStr & ZIP & " "
If City <> "" Then HStr = HStr & City
Adresse = Trim(HStr)
End Function



allerdings habe ich das problem, dass er mir als entfernungswert immer etwas anderes ausgibt und ich die pure "km" Angabe nicht herausgelöst bekomme.

ich hänge das excel file mit dem Makro mal an
http://rapidshare.com/files/448247324/Stefan_1.xlsm

die reine excel tabelle hängt als bild nochmal an, wer sich keine datei mit makro runterladen will, ansonsten steht die XLSM auch zum download bereit.
:)

ich hoffe sehr ihr könnt mir helfen, wie ich die reine Entfernung in die dafür vorgesehene Spalte ausgeben kann.
Vielen Vielen Dank im Voraus, ich benötige diese Berechnung für meine Bachelorarbeit für dann über 1000 Datensätze, daher kann ich nicht einfach die 2 Entfernungen selbst nachschauen:frown:

[cessy000]

hi,

wird schwierig....
nimm mal das kommentar von dieser zeile raus:
'Debug.Print IEDoc.Body.innerText
also ändere es in so:
Debug.Print IEDoc.Body.innerText

und schau dir mal an was da dann alles im direktfenster in excel angezeigt wird.
du hast leider keinen anhaltspunkt welche KM Angabe die richtige ist....
ist es immer die maximale ?
dann kannst du ne schleife einbauen das dir die maximale km zahl immer ausgegeben wird.

:-)
aber ohne vba kenntnisse wird das nicht klappen.


lg
cessy

[_Funkiwi_]

anhaltspunkte welche KM angabe die richtige ist hab ich schon, weil eigentlich immer die erste angabe richtig ist. ich bekomm sie lediglich nicht extrahiert aus dem ganzen krams. ich hab im netz noch einen weiteren
VBA code gefunden, der sich


Sub Entfernung_google()
Dim IEApp As Object
Dim IEDocument As Object
Set IEApp = CreateObject("InternetExplorer.Application")
For i = 2 To Tabelle1.UsedRange.Rows.Count
IEApp.Visible = False
IEApp.Navigate "http://maps.google.de/maps?saddr=" & Tabelle1.Cells(i, 5).Value & _
"&daddr=" & Tabelle1.Cells(i, 1).Value & "&output=html"
Application.StatusBar = "Start-> " & Tabelle1.Cells(i, 5).Value & _
" Ziel-> " & Tabelle1.Cells(i, 1).Value
Do: Loop Until IEApp.Busy = False
Do: Loop Until IEApp.Busy = False
Set IEDocument = IEApp.Document
Do: Loop Until IEDocument.ReadyState = "complete"
Set result = IEDocument.getElementById("dditd")
If Not result Is Nothing Then
teile = Split(result.innerText, "–")
Tabelle1.Cells(i, 3).Value = teile(0)
Tabelle1.Cells(i, 4).Value = teile(1)
End If
Set IEDocument = Nothing
Next
IEApp.Quit
Set IEApp = Nothing
Application.StatusBar = False
MsgBox "Fertig"
End Sub


so liest, das problem an der sache ist (läuft fehlerfrei durch und nimmt auch die richtigen adressen), dass der mir gar nix auswirft an entfernung. hmmmmmmmmmhmhm.

ich muss zugeben, ich steh aufm schlauch

[robobimbo]

Hm, wenn Du Dir im IE das Ergebnis HTML Ansiehst, ist bei mir die Angabe zu der Entfernung in einem Div Element ohne ID dafür mit der css-klasse "altroute-info" <div class="altroute-info">

Wenn du vom ersten dass Du findest dass innerHTML nimmst, solltest Du deine km-Angabe haben.

Dafür solltest Du die Methode getElementsByClassName verwenden und davon das erste auswerten. Doku: http://msdn.microsoft.com/en-us/library/ff975198(v=VS.85).aspx

[_Funkiwi_]

Hallo robobimbo.

Danke für deine Hilfe, jetzt funktioniert es, aber leider erhalte ich eine Angabe in der Form "35 km" (ohne die ") und damit kann man leider in excel nicht rechnen, kannst du mir bitte sagen wie ich alleine die Zahl extrahiert bekomme?

grüße funkiwi

[robobimbo]

hm, mal ins blaue geschossen sollte ein Val("35 km") bzw. in deinem Fall ein Val(result) Dir eine Zahl 35 zurückliefern :)

[_Funkiwi_]

probier ich heute nachmittag mal aus, danke