Kapalı dosyadan istenilen ilin ücretini çekme

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; elimde Bir kapalı olan SÜREKLİ GÖREV YOLLUĞU 2020 (kapalı dosya) adlı bir dosyam var. Bu dosyamın yolu aşağıda;
yol = "D:\Belgelerim\Personel\İlişik Kesen Personel\"
dosya = "SÜREKLİ GÖREV YOLLUĞU 2020.xls"
Sayfaadı = "MESAFE"


Kapalı olan bu dosyadan B4 Sütununda bulunan ve bunun karşılığı olan CF4 sütununda bulunan Taşıt Ücretlerinin GEÇİCİ GÖREV YOLLUĞU 2020 (açık dosya) dosyasının D8 Hücresine yazmış olduğum ile göre taşıt ücretini bularak K8 hücresine yazmasını için bir kod yazmanızı saygıyla arz ediyorum. İyi akşamlar.

 

[Korhan Ayhan]

HACI isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

"d8:d17" hücre aralığında il adı yazdığınızda sonucu getirecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim File_Path As String, My_File As String, My_Cell As Range
   
    File_Path = "D:\Belgelerim\Personel\İlişik Kesen Personel\"
    My_File = "[SÜREKLİ GÖREV YOLLUĞU 2020.xls]MESAFE'!"
           
    For Each My_Cell In Intersect(Target, Range("D8:D17")).Cells
        If My_Cell.Value <> "" Then
            With Cells(My_Cell.Row, "K")
                .Formula = "=INDEX('" & File_Path & My_File & "A:CF,MATCH(""" & My_Cell.Value & """,'" & File_Path & My_File & "B:B,0),84)"
                .Value = .Value
            End With
        Else
            Cells(My_Cell.Row, "K").ClearContents
        End If
    Next
End Sub

 

[Hacı Bayram ÖZKAN]

Teşekkürler Sayın abim iyi geceler dua ile kalın

 

[Hacı Bayram ÖZKAN]

Merhabalar; Sayın abim bu kodu dosyama uyguladığımda;
"Object variable or with block vaiable not set" diye bir uyarı veriyor. ve
For Each My_Cell In Intersect(Target, Range("D817")).Cells bu satır sarı yandı, buna bakar bilir misin?
Abim sana zahmet bunu Sayfanın koduna değilde, modülde çalışacak şekilde yazar mısın? Çünkü sayfanın kodunda sicille birlikte bilgileri getiren başka kod var. O yüzden istiyorum.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Import_Data()
    Dim File_Path As String, My_File As String, My_Cell As Range
    
    File_Path = "D:\Belgelerim\Personel\İlişik Kesen Personel\"
    My_File = "[SÜREKLİ GÖREV YOLLUĞU 2020.xls]MESAFE'!"
            
    For Each My_Cell In Range("D8:D17").Cells
        If My_Cell.Value <> "" Then
            With Cells(My_Cell.Row, "K")
                .Formula = "=INDEX('" & File_Path & My_File & "A:CF,MATCH(""" & _
                           My_Cell.Value & """,'" & File_Path & My_File & "B:B,0),84)"
                .Value = .Value
            End With
        Else
            Cells(My_Cell.Row, "K").ClearContents
        End If
    Next
    
    MsgBox "Your transaction is complete."
End Sub

 

[Hacı Bayram ÖZKAN]

Elinize sağlık Korhan bey çok güzel oldu ve çalıştı. Teşekkür ediyorum Sağlıcakla kalın.
Bilgi amaçlı soruyorum, 2 nolu mesajınızdaki kodda neden çalışmıyor.

 

[Korhan Ayhan]

Kodu deneyerek paylaşmıştım. Siz asıl dosyanızda başka kod olduğunu ifade etmiştiniz. Belki çakışma oluşmuştur.

 

[Hacı Bayram ÖZKAN]

Sayın Hocalarım; şu kod işime yaradı. Bunun sayın Korhan Ayhan hocam yazmıştı. Buna ek olarak şunu istiyorum.

Sub Import_Data()
Dim File_Path As String, My_File As String, My_Cell As Range

File_Path = "D:\Belgelerim\Personel\İlişik Kesen Personel\"
My_File = "[SÜREKLİ GÖREV YOLLUĞU 2022.xls]MESAFE'!"

For Each My_Cell In Range("P620").Cells
If My_Cell.Value <> "" Then
With Cells(My_Cell.Row, "R") ' R Kolonuna taşıt ücretini yazıyor.
.Formula = "=INDEX('" & File_Path & My_File & "A:CF,MATCH(""" & _
My_Cell.Value & """,'" & File_Path & My_File & "B:B,0),84)"
.Value = .Value
End With
Else
'Cells(My_Cell.Row, "R").ClearContents
End If
Next

MsgBox "Taşıt Ücreti Getirildi."
End Sub

Q Kolonunda Özel Oto yazıyorsa sadece bu satırdaki ilin ücretini getirsin. Resmi oto yazıyorsa getirmesin
Herkese teşekkür ederim.

 

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; Korhan Ayhan hocamın yazmış olduğu koda ek yapmak istiyorum, isteğimi 8 nolu mesajda anlattım. Bakarsanız sevinirim. Teşekürler.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Import_Data()
    Dim File_Path As String, My_File As String, My_Cell As Range
    
    File_Path = "D:\Belgelerim\Personel\İlişik Kesen Personel\"
    My_File = "[SÜREKLİ GÖREV YOLLUĞU 2022.xls]MESAFE'!"
    
    For Each My_Cell In Range("P6:P20").Cells
        If My_Cell.Value <> "" Then
            If Cells(My_Cell.Row, "Q") = "Özel Oto" Then
                With Cells(My_Cell.Row, "R") ' R Kolonuna taşıt ücretini yazıyor.
                    .Formula = "=INDEX('" & File_Path & My_File & "A:CF,MATCH(""" & _
                    My_Cell.Value & """,'" & File_Path & My_File & "B:B,0),84)"
                    .Value = .Value
                End With
            Else
                Cells(My_Cell.Row, "R").ClearContents
            End If
        Else
            Cells(My_Cell.Row, "R").ClearContents
        End If
    Next
    
    MsgBox "Taşıt Ücreti Getirildi."
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın abim, eline sağlık çalıştı çok teşekkür ederim. Allaha emanet ol.