Unique Verileri alma

[MURATSO]

arkadaşlar merhaba,

site içerisinde bulamadım ama macro ile sheet1 a hücresindeki bir değeri sheet 2 nin a kolonunda arayıp c kolonundaki karşılığının unique değerlerini sheet1 b kolonuna nasıl alabilirim?

örnek data ektedir

 

[muygun]

belirli kritere uyan tekrarsız veriler

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[veyselemre]

Sub test()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    s1.Range("B1:B" & Rows.Count).ClearContents
    
    lst = s2.Range("A1:C" & s2.Cells(Rows.Count, 3).End(3).Row).Value2

    With CreateObject("Scripting.Dictionary")
        For i = LBound(lst) To UBound(lst)
            Key = lst(i, 1) & "|" & lst(i, 3)
            x0 = .Item(Key)
        Next i
        lst = .keys
        .RemoveAll
        
        For i = LBound(lst) To UBound(lst)
            ver = Split(lst(i), "|")
            Key = ver(0)
            .Item(Key) = .Item(Key) & "|" & ver(1)
        Next i
        
        Key = s1.Range("A1").Value
        If .exists(Key) Then
            bol = Split(Mid(.Item(Key), 2), "|")
            s1.Range("B1").Resize(UBound(bol) + 1, 1).Value = Application.Transpose(bol)
        End If
    End With

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[MURATSO]

ellerinize sağlık teşekkür ederim

 

[MURATSO]

bakıldığında aslında çok kolay gibi görünen bir kod aslında ne kadar çok farklı ve zor olabiliyor. sanırım ben bu macro yazma işini öğrenemicem