for döngüsü yardım

[polist]

selam arkadaşlar

örnek dosyayı yükledim , içerisinde ifade ettim

yardımcı olursanız sevinirim

teşekkür ederim

forum.xlsx dosyasını indir - download

forum.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s5.dosya.tc

 

[Muzaffer Ali]

Merhaba.
Bir modüle aşağıdaki kodu kopyalayıp çalıştırın.

Sub Test()
    Dim syfAna As Worksheet, syfGuncel As Worksheet
    Dim Bak As Long
    Dim Bul As Range

    Set syfAna = ThisWorkbook.Worksheets("ANA")
    Set syfGuncel = ThisWorkbook.Worksheets("GUNCEL_PRIM")

    syfAna.Range("C2:F" & syfAna.Cells(Rows.Count, "F").End(xlUp).Row).Copy syfAna.Range("B2")
    syfAna.Range("F2:F" & Rows.Count).ClearContents
  
    For Bak = 2 To syfAna.Cells(Rows.Count, "A").End(xlUp).Row
        Set Bul = syfGuncel.Range("A:A").Find(what:=syfAna.Cells(Bak, "A"), lookat:=xlWhole)
        If Bul Is Nothing Then
            syfAna.Cells(Bak, "F") = "Bulunamadı"
        Else
            syfAna.Cells(Bak, "F") = syfGuncel.Cells(Bul.Row, "B")
        End If
    Next
End Sub

 

[polist]

Merhaba.
Bir modüle aşağıdaki kodu kopyalayıp çalıştırın.

Sub Test()
    Dim syfAna As Worksheet, syfGuncel As Worksheet
    Dim Bak As Long
    Dim Bul As Range
    Set syfAna = ThisWorkbook.Worksheets("ANA")
    Set syfGuncel = ThisWorkbook.Worksheets("GUNCEL_PRIM")
    syfAna.Range("C2:F" & syfAna.Cells(Rows.Count, "F").End(xlUp).Row).Copy syfAna.Range("B2")
    syfAna.Range("F2:F" & Rows.Count).ClearContents
 
    For Bak = 2 To syfAna.Cells(Rows.Count, "A").End(xlUp).Row
        Set Bul = syfGuncel.Range("A:A").Find(what:=syfAna.Cells(Bak, "A"), lookat:=xlWhole)
        If Bul Is Nothing Then
            syfAna.Cells(Bak, "F") = "Bulunamadı"
        Else
            syfAna.Cells(Bak, "F") = syfGuncel.Cells(Bul.Row, "B")
        End If
    Next
End Sub

çok teşekkür ederim istediğim gibi oldu .. elinize sağlık

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.