Aşağıda bulunan kodu uzun zamandır kullanıyorum.
mantığı ,
1. sütuna paris 2. sütuna istanbul yazdığımızda 3. sütun a da kodu yapıştırdığımızda aralarındaki km yi vermekte. ilgili kodu çok fazla kullanıdığımızda bir şekilde kilitleniyor. İnterneti kapatıp açmadan da bir daha km vermiyor. bu konuda bana yardımcı olabilirmisin.
Aynı anda 1100 satıra birden yapıştırıyorum.
[/QUOTE]
mantığı ,
1. sütuna paris 2. sütuna istanbul yazdığımızda 3. sütun a da kodu yapıştırdığımızda aralarındaki km yi vermekte. ilgili kodu çok fazla kullanıdığımızda bir şekilde kilitleniyor. İnterneti kapatıp açmadan da bir daha km vermiyor. bu konuda bana yardımcı olabilirmisin.
Aynı anda 1100 satıra birden yapıştırıyorum.
Kod:
Dim guzergah, konumu
Sub Menu()
sonsatir = Cells(Rows.Count, "A").End(3).Row
Range("Z5:Z100000").ClearContents
For i = 2 To sonsatir
guzergah = turkce_harf_olmasin(Cells(i, 20).Value)
konumu = turkce_harf_olmasin(Cells(i, 25).Value)
Cells(i, 26).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 "á": gecici = gecici + "a"
Case "è": gecici = gecici + "e"
Case "ä": gecici = gecici + "a"
Case "ß": gecici = gecici + "b"
Case Else: gecici = gecici + h
End Select
Next i
turkce_harf_olmasin = gecici
End Function
