Şehirler arası km hesaplatma

[sakoz]

Hüseyin Merhaba ,

Kusura bakma...yazdıklarını ancak şimdi deneyebildim...18.mesajda belirttiklerini denedim...Fakat makroyu çalıştırınca "Km Tablosuna EDREMİT tanımlayınız" mesajı verdi...Bunun üzerine bende Rapor sayfasındaki İl isimlerini küçük harfle yazıp denedim ve küçük harfle yazdıklarımı kabul edip hesapladı...Büyük harfle olanları hesaplamadı...
Ayrıca gösterdiğin bu ilgiye çok teşekkür ederim...Allah razı olsun senden ...

 

[hsayar]

şu an büyük küçük harf sorunu mu yaşıyorsun? son halini bir örnek olarak ekle, onu da ortadan kaldıralım.

 

[sakoz]

Hüseyin Dosyayı tekrar ekledim...
Bilgine...

 

[hsayar]

Aşağıdaki satırları bir altakiler ile değiştir.

       il1 = .Cells(i, "b").Offset(-1, 0)
       il2 = .Cells(i, "b").Offset(0, 0)

       il1 = [COLOR=Green]rTrim([/COLOR].Cells(i, "b").Offset(-1, 0)[COLOR=Green])[/COLOR]
       il2 = [COLOR=Green]rTrim([/COLOR].Cells(i, "b").Offset(0, 0)[COLOR=Green])[/COLOR]

ama en iyisi bundan sonraki kodlarda satır aralıdığın prosodürü aşağıdaki şekilde kullan;

Sub Poz_No_Degistiginde_Satir_Ac()
    Dim i As Integer
    Dim x As Integer
    Dim sKon As String
    Dim rng As Range
    
    On Error GoTo Hata_Yakala
    
    For i = 2 To Cells(65536, 1).End(xlUp).Row
     [COLOR=Green] If Cells(i, 2) <> "" Then Cells(i, 2) = rTrim(Cells(i, 2)) 'Boşlukları Al[/COLOR]
        If i = 2 Then
            sKon = Cells(i, 1)
        Else
            If Cells(i, 1) <> sKon Then
                sKon = Cells(i, 1)
                x = x + 1
                If x = 1 Then
                    Set rng = Cells(i, 1)
                Else
                    Set rng = Application.Union(rng, Cells(i, 1))
                End If
            End If
        End If
    Next i
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    rng.EntireRow.Insert
    Call Mesafeleri_Yaz
    
Hata_Yakala:
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Set rng = Nothing
End Sub

 

[sakoz]

Hüseyin allah senden razı olsun...Ellerine ve emegine sağlık...Şuan itibariyle normal olarak çalışıyor..Tekrar teşekkür ederim...Saygılar..

 

[hsayar]

saygı benden salim görüşmek üzere

 

[hsayar]

salim 20. mesajdaki halini denedinmi.. (mesafeleri yaz modulünde dediğim yerleri sadece rtrim yapıp dene)

 

[sakoz]

Evet Hüseyin 20.mesajdaki halini denedim...Kenarlıklarla ilgili olan...Gayet güzel çalışıyor...
mesafeleri yaz modulünde dediğin yerleri sadece rtrim yapıp denedim....Bu da normal olarak çalışıyor...Bilgin olsun...