KM hesaplama yardım

[fearpirat]

Arkadaşlar excel ile ilgili olarak orta seviye bir bilgim mevcut.
Ama 40 güne yakındır her akşam uğraşmama rağmen yapamadım. yabancı kaynakları bile kurcalamama rağmen .
Örnek bir yabancı kaynak mevcut ; http://oco-carbon.com/coding/google-excel-distance-function/



güzergah durumuna tıkladığımda adreslerin bulunduğu adresleri google da otomatik mesafesini gösteriyor. ama her 10 dk da bir 150 adresi tek tek kontrol etmemin ve 4. sütuna yazmamın imkanı yok.

a2 sütünu ve b2 sütünundaki adreslerin arasında ki km yi d2 sütünuna yazabilmek.

 

[Asri]

Excel VBA da Tools / References de Microsoft XML 6.0 ı seçip tamam deyin.

http://www.dosyaupload.com/Lfv

Dim guzergah, konumu

Sub Menu()
sonsatir = Cells(Rows.Count, "A").End(3).Row
Range("D2:D100000").ClearContents
For i = 2 To sonsatir
  guzergah = turkce_harf_olmasin(Cells(i, 1).Value)
  konumu = turkce_harf_olmasin(Cells(i, 2).Value)
  Cells(i, 4).Value = mesafegetir(guzergah, konumu)
Next i
End Sub


Function mesafegetir(Origin, Destination) As Double
' Requires a reference to Microsoft XML, v6.0
' Draws on the stackoverflow answer at bit.ly/parseXML
Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim distanceNode As IXMLDOMNode
    mesafegetir = 0
    ' Check and clean inputs
    On Error GoTo exitRoute
    'Origin = WorksheetFunction.EncodeURL(Origin)
    'Destination = WorksheetFunction.EncodeURL(Destination)
    ' Read the XML data from the Google Maps API
    Set myRequest = New XMLHTTP60
    urlsi = "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
        & Origin & "&destination=" & Destination & "&sensor=false"
    myRequest.Open "GET", urlsi, False
    myRequest.send
    ' Make the XML readable usign XPath
    Set myDomDoc = New DOMDocument60
    myDomDoc.LoadXML myRequest.responseText
    ' Get the distance node value
    Set distanceNode = myDomDoc.SelectSingleNode("//leg/distance/value")
    If Not distanceNode Is Nothing Then mesafegetir = distanceNode.Text / 1000
exitRoute:
    ' Tidy up
    Set distanceNode = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing
End Function

Public Function turkce_harf_olmasin(cumle)
gecici = ""
For i = 1 To Len(cumle)
          h = Mid(cumle, i, 1)
          Select Case h
            Case "ğ": gecici = gecici + "g"
            Case "Ğ": gecici = gecici + "G"
            Case "ü": gecici = gecici + "u"
            Case "Ü": gecici = gecici + "U"
            Case "ş": gecici = gecici + "s"
            Case "Ş": gecici = gecici + "S"
            Case "ç": gecici = gecici + "c"
            Case "Ç": gecici = gecici + "C"
            Case "ö": gecici = gecici + "o"
            Case "Ö": gecici = gecici + "O"
            Case "İ": gecici = gecici + "I"
            Case "ı": gecici = gecici + "i"
            Case Else: gecici = gecici + h
            End Select
Next i
turkce_harf_olmasin = gecici
End Function

 

[fearpirat]

Asri tesekkur ederim referans gosterdim ama yine olmadi acaba benim gonderdigim calisma sayfasina entegre edip goderme sansiniz mevcutmu .

 

[Asri]

Asri tesekkur ederim referans gosterdim ama yine olmadi acaba benim gonderdigim calisma sayfasina entegre edip goderme sansiniz mevcutmu .

dosyaupload.com a yüklerseniz olabilir

 

[5353]

http://www.dosyaupload.com/Lfo asri için :

 

[Asri]

İlk mesajım güncellendi.

 

[fearpirat]

Asri sen mukemmel bir adamsin ellerine saglik ssuper olmus ☺

 

[Asri]

Asri sen mukemmel bir adamsin ellerine saglik ssuper olmus ☺

İşinize yaramasına sevindim.

Harita linkleri program tarafından oluşturulacak şekilde düzenlendi.

http://www.excel.web.tr/f52/excel-google-maps-oklu-kilometre-sorgulama-t161930.html

 

[fearpirat]

Asri merhaba , Devamlı kullandığım bu excel dosyası artık çalışmamakta bana bu konuda yardımcı olabilirsen çok sevinirim. Uzun bir süredir bu exceli kullanıyordum.

 

[alialtiner]

herhangi bir gelişme varmı konu ile ilgili olarak?