Mesafeyi bulup yazsın

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar, sürekli görev yolluğunda MESAFE diye sayfam var, Adıyaman İlinin C8 hücresine yazmış olduğum, ilin mesafesini buradan bulup K8 Hücresine yazmasını istiyorum. Saygılarımla.

 

[Ömer BARAN]

Merhaba.
Formül:

=KAYDIR(MESAFE!$B$3;KAÇINCI($A8;MESAFE!$B$4:$B$84;0);KAÇINCI($C8;MESAFE!$C$3:$CE$3;0))

 

[Hacı Bayram ÖZKAN]

Ömer bey teşekkür ederim. Eline sağlık.

 

[Ömer BARAN]

Kolay gelsin.

 

[çıtır]

Alternatif olarak.

=EĞERHATA(YATAYARA($C$8;MESAFE!$C$3:$CE$5;3;0);"")

 

[Hacı Bayram ÖZKAN]

Sayın çıtır teşekkür ederim alternatif olarak birde makro yazabilir misin?

 

[çıtır]

Sayfa kodu olarak

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
        Exit Sub
    End If
If Intersect(Target, [B8]) Is Nothing Then Exit Sub
Dim s1 As Worksheet
Set s1 = Sheets("MESAFE")
[K8] = WorksheetFunction.HLookup(Range("B8"), s1.Range("C3:CE5"), 3, 0)
End Sub

 

[Hacı Bayram ÖZKAN]

Teşekkür ederim abim iyi geceler

 

[çıtır]

Teşekkür ederim abim iyi geceler

Bir modüle kopyalayınız.Tüm sayfalara yazar.

Sub ara()
Dim i As Integer
Dim s1 As Worksheet
Set s1 = Sheets("MESAFE")
For i = 1 To Worksheets.Count
sayfaadı = Worksheets(i).Name
If sayfaadı = "MESAFE" Then GoTo 10
If Sheets(i).Range("B8") = "" Then
Sheets(i).Range("K8") = ""
End If
say = WorksheetFunction.CountIf(s1.Range("c3:CE3"), Sheets(i).Range("B8"))
If say > 0 Then
Sheets(i).Range("K8") = WorksheetFunction.HLookup(Sheets(i).Range("B8"), s1.Range("C3:CE5"), 3, 0)
End If
If say = 0 Then
Sheets(i).Range("K8") = ""
End If
10:
Next i
End Sub

Dönüş yaptığınız için teşekkür ederim.İyi geçeler.

 

[Hacı Bayram ÖZKAN]

Merhaba sayın Çıtır, iyi geceler yazmış olduğunuz kodda birde I8 e veri getirmesini istiyorum, bu kodu düzenleye bilir misiniz? Teşekkürler
I8 de ücretler yer alacak, bunlarda CF sütununda..

 

[Hacı Bayram ÖZKAN]

iyi geceler arkadaşlar; 10 nolu mesajdaki dosyada dosyada K8 kilometreler geliyor, birde I8 e ücretlerin gelmesini istiyorum, koda nasıl bir değişiklik yapılabilir. Teşekkür ederim.

 

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar bu konuya bir bakar mısınız?

 

[YUSUF44]

I8 formülü:

=EĞER(C8="";"";DÜŞEYARA(C8;MESAFE!$B$4:$CF$84;83;0))

#7 nolu mesajdaki sayfa kodu:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
        Exit Sub
    End If
If Intersect(Target, [C8:C17]) Is Nothing Then Exit Sub
Dim s1 As Worksheet
Set s1 = Sheets("MESAFE")
Target.Offset(0, 6) = WorksheetFunction.HLookup(Target, s1.Range("C3:CE5"), 3, 0)
End Sub

 

[baydeniro]

I8 formülü:

=EĞER(C8="";"";DÜŞEYARA(C8;MESAFE!$B$4:$CF$84;83;0))

#7 nolu mesajdaki sayfa kodu:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
        Exit Sub
    End If
If Intersect(Target, [C8:C17]) Is Nothing Then Exit Sub
Dim s1 As Worksheet
Set s1 = Sheets("MESAFE")
Target.Offset(0, 6) = WorksheetFunction.HLookup(Target, s1.Range("C3:CE5"), 3, 0)
End Sub

Tebrikler üstad, harika bir kod olmuş.

 

[baydeniro]

Alternatif olarak.

=EĞERHATA(YATAYARA($C$8;MESAFE!$C$3:$CE$5;3;0);"")

Teşekkürler üstad, faydalandık.

 

[baydeniro]

Merhaba.
Formül:

Teşekkürler üstad, faydalandık.

 

[Hacı Bayram ÖZKAN]

YUSUF abi bu yazdığın formül var ya=EĞER(C8="";"";DÜŞEYARA(C8;MESAFE!$B$4:$CF$84;83;0)) bunu koda ekleye bilir miyiz. Yani C8 Gideceği yeri yazınca kod ile ile hem I8 deki ücret, hemde K8 deki km gelecek. Yani formül olmadan sayfa koduna

 

[YUSUF44]

Bunu mu kastediyorsunuz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
    
If Intersect(Target, [C8:C17, A8:A17]) Is Nothing Then Exit Sub
Set s1 = Sheets("MESAFE")
a = Target.Row
son = s1.Cells(Rows.Count, "B").End(3).Row

If Cells(a, "A") <> "" And Cells(a, "C") <> "" Then
    If WorksheetFunction.CountIf(s1.Range("B1:B" & son), Cells(a, "A")) > 0 And _
        WorksheetFunction.CountIf(s1.Range("B1:B" & son), Cells(a, "C")) > 0 Then
            sat = WorksheetFunction.Match(Cells(a, "C"), s1.Range("B1:B" & son), 0)
            Cells(a, "I") = s1.Cells(sat, "CF")
            Cells(a, "K") = s1.Cells(sat, "D")
    ElseIf WorksheetFunction.CountIf(s1.Range("B1:B" & son), Cells(a, "A")) = 0 Then
        MsgBox "Çıkış yerini doğru yazınız!", vbCritical
        Exit Sub
    ElseIf WorksheetFunction.CountIf(s1.Range("B1:B" & son), Cells(a, "C")) = 0 Then
        MsgBox "Çıkış yerini doğru yazınız!", vbCritical
        Exit Sub
    End If
End If

End Sub

Ekleme: Kodda düzeltme yapıldı.

 

[Hacı Bayram ÖZKAN]

Merhaba abim, eline sağlık benim için uğraştın, verilerde ücretler doğru geliyor, KM ler yanlış geliyor tabloyu bize göre düzenledim, İlçemize en alta aldım, bu durumda ücretler doğru geliyor, KM ler yanlış gelmesi gerekenleri yanda açıkladım, birde abi bunu modül 2'ye ekleyecek şekilde yazar mısın? Sana zahmet verdim ama dua ile kal.

 

[YUSUF44]

Dünkü kodlar dünkü dosyanıza göreydi ve dünkü dosyanızda doğru sonuçlar veriyordu. Siz bugün başka dosyada işlem yapıyorsunuz, dosya düzenini değiştirmiş, Gölbaşı'ya göre uygulanmasını istemişsiniz. Bu durumda makroda da değişiklikler yapılması gerekiyor. Her zaman örnek dosyanızla asıl dosyanız aynı yapıda olsun ve her zaman asıl sormak istediğinizi sorun lütfen.

Sayfa kodunu aşağıdakiyle değiştirip deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
    
If Intersect(Target, [C8:C17, A8:A17]) Is Nothing Then Exit Sub
Set s1 = Sheets("MESAFE")
a = Target.Row
sonsat = s1.Cells(Rows.Count, "B").End(3).Row
sonsut = s1.Cells(3, Columns.Count).End(xlToLeft).Column

If Cells(a, "A") <> "" And Cells(a, "C") <> "" Then
    If WorksheetFunction.CountIf(s1.Range("B1:B" & sonsat), Cells(a, "A")) > 0 And _
        WorksheetFunction.CountIf(s1.Range(s1.Cells(3, "A"), s1.Cells(3, sonsut)), Cells(a, "C")) > 0 Then
            sat = WorksheetFunction.Match(Cells(a, "A"), s1.Range("B1:B" & sonsat), 0)
            satTL = WorksheetFunction.Match(Cells(a, "C"), s1.Range("B1:B" & sonsat), 0)
            sut = WorksheetFunction.Match(Cells(a, "C"), s1.Range(s1.Cells(3, "A"), s1.Cells(3, sonsut)), 0)
            Cells(a, "I") = s1.Cells(satTL, "CF")
            Cells(a, "K") = s1.Cells(sat, sut)
    ElseIf WorksheetFunction.CountIf(s1.Range("B1:B" & sonsat), Cells(a, "A")) = 0 Then
        MsgBox "Çıkış yerini doğru yazınız!", vbCritical
        Cells(a, "I").ClearContents
        Cells(a, "K").ClearContents
        Exit Sub
    ElseIf WorksheetFunction.CountIf(s1.Range(s1.Cells(3, "A"), s1.Cells(3, sonsut)), Cells(a, "C")) = 0 Then
        MsgBox "Çıkış yerini doğru yazınız!", vbCritical
        Cells(a, "I").ClearContents
        Cells(a, "K").ClearContents
        Exit Sub
    End If
End If

End Sub

Modüle kopyalamaktan kastınız nedir, ne yapmak istiyorsunuz?