Makrolu Düşeyara

[Erhan Üstünel]

Merhaba arkadaşlar, eklediğim dosya üzerinde formül ile ıban ve TC Kimlik no larını düşeyara ile getiriyorum fakat liste uzun olunca bulamadığım bi hata veriyor, Personel isimlerini yazınca makro ile nasıl IBAN ve TC KIMLIK no larını getireceğimiz kod da yardımcı olursanız sevinirim.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub PERSONEL_ARA()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim X As Long, BUL As Range
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Maaş_Giriş_Sayfası")
    Set S2 = Sheets("HESno")
    
    For X = 5 To S1.Cells(Rows.Count, "E").End(3).Row
        S1.Cells(X, "C") = ""
        S1.Cells(X, "F") = ""
        If S1.Cells(X, "E") <> "" Then
            Set BUL = S2.Range("A:A").Find(S1.Cells(X, "E"), , , xlWhole)
            If Not BUL Is Nothing Then
                S1.Cells(X, "C") = BUL.Offset(0, 2)
                S1.Cells(X, "F") = BUL.Offset(0, 1)
            End If
        End If
    Next
    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Erhan Üstünel]

Hocam çok teşekkür ediyorum, Elinize emeğinize sağlık

 

[dayi10]

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub PERSONEL_ARA()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim X As Long, BUL As Range
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Maaş_Giriş_Sayfası")
    Set S2 = Sheets("HESno")
    
    For X = 5 To S1.Cells(Rows.Count, "E").End(3).Row
        S1.Cells(X, "C") = ""
        S1.Cells(X, "F") = ""
        If S1.Cells(X, "E") <> "" Then
            Set BUL = S2.Range("A:A").Find(S1.Cells(X, "E"), , , xlWhole)
            If Not BUL Is Nothing Then
                S1.Cells(X, "C") = BUL.Offset(0, 2)
                S1.Cells(X, "F") = BUL.Offset(0, 1)
            End If
        End If
    Next
    
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

korhan bey ekteki örneği yapmak istiyorum. nasıl uyarlayabilirim sizin bu örneğinize göre.

 

[Erdem Akdemir]

Merhaba,

Formül,

=DÜŞEYARA(F12;Sayfa2!$A$1:$B$12;2;0)

Kod,

Sub getir()
son = Cells(Rows.Count, "f").End(3).Row
For Each alan In Range("f12:f" & son)
alan.Offset(0, -4).Value = Application.WorksheetFunction.VLookup(alan.Value, Sayfa2.Range("A2:B12"), 2, 0)
Next
End Sub