aratıp bulma makrosu

[emrebengul]

yolldığım dosyada Sayfa1de A sütünundaki verileri, Sayfa2de A sütunundaki verilerle eşleştirip. Sayfa 2de A sütunu verilerinin karşısında "NO" İsimli hücrenin altında ne yazıyorsa onları Sayfa1de "NO" hücresinde altında yazmasını istiyorum. anlatabilmişimdir umarım. excel dosyasındada yazdım içerisinde açıklmasını yardımcı olursanız çok iyi olur.

 

[çıtır]

Deneyiniz.

Sub bulyaz()
Dim S1 As Worksheet, S2 As Worksheet, yaz As Range: Dim i As Integer
    Set S1 = Sheets("Sayfa1"): Set S2 = Sheets("Sayfa2")
    son1 = S1.Cells(65355, "A").End(3).Row: Son2 = S2.Cells(65355, "A").End(3).Row
    S1.Range("B2:B" & Rows.Count).Cells.ClearContents
    For i = 2 To son1
    Set yaz = S2.Range("A2:A" & Son2).Find(S1.Range("A" & i), , , xlWhole)
    If Not yaz Is Nothing Then
       S1.Range("B" & i) = yaz.Offset(0, 1)
        End If
Next i
MsgBox "İŞLEM TAMAMLANDI", vbInformation
End Sub

 

[muygun]

Merhaba;
Alternatif olsun.
Sayfa1 kod bölümüne;

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("A2:A65536")) Is Nothing Then
sat = Target.Row
Cells(sat, "b") = WorksheetFunction.SumIf(Sheets("Sayfa2").Range("a2:a65536"), Cells(sat, 1), Sheets("Sayfa2").Range("b2:b65536"))
End If
End Sub

Kodlarını yerleştirip A sütununa herhangi isim yazarak deneyin.
İyi çalışmalar.

 

[emrebengul]

çok teşekkür ederim sağ olun