İki adet isim listesinden farklı olanları listeleme

[Mdemir63]

Selamlar.
Arkadaşlar iki adet isim listem var bunları karşılaştırıp farklı olanları listeleme yapmak istiyorum. Nasıl yapabilirim.

Forumda aradım bulamadım

Saygılar

 

[Orion1]

Selamlar.
Arkadaşlar iki adet isim listem var bunları karşılaştırıp farklı olanları listeleme yapmak istiyorum. Nasıl yapabilirim.

Forumda aradım bulamadım

Saygılar

Örnek dosyayı eklermisiniz?

 

[Mdemir63]

Hocam selamlar,
Örnek dosya ekte

Saygılar

 

[Orion1]

Dosyanız ekte.

Sub benzersiz()
Dim i As Byte, k As Long, a As Long, syf As Byte
Sheets("Sayfa3").Select
Application.ScreenUpdating = False
Range("A2:B65536").Clear
ReDim myarr(1 To 2, 1 To 1)
For i = 1 To 2
    If i = 1 Then
        syf = 2
        Else
        syf = 1
    End If
    For k = 2 To Sheets(i).Cells(65536, "B").End(xlUp).Row
        If WorksheetFunction.CountIf(Sheets(syf).Range("B2:B65536"), Sheets(i).Cells(k, "B").Value) = 0 Then
            a = a + 1
            ReDim Preserve myarr(1 To 2, 1 To a)
            myarr(1, a) = a
            myarr(2, a) = Sheets(i).Cells(k, "B").Value
        End If
    Next k
Next i
If a > 0 Then
    [A2].Resize(a, 2) = Application.Transpose(myarr)
End If
Application.ScreenUpdating = True
MsgBox "Benzersizler Listelendi..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[Mdemir63]

Hocam harikası
Çok Teşekkür ederim

Peki hocam listenin dahada uzaması bir şey değiştirmez değil mi?
Hocam ayrıca şunu yapma şansımız nasıl olur yine bu iki listeden sadece ikisinde birlikte olmayanları listeleyebilirmiyiz.?

Saygılar

 

[Orion1]

Hocam harikası
Çok Teşekkür ederim

Peki hocam listenin dahada uzaması bir şey değiştirmez değil mi?
Hocam ayrıca şunu yapma şansımız nasıl olur yine bu iki listeden sadece ikisinde birlikte olmayanları listeleyebilirmiyiz.?

Saygılar

1nci sorunuz ,Sadece çok uzarsa kodların çalışması biraz dağa uzar.
2nci sorunuz ,zaten dediğiniz şekilde çalışıyor.

 

[Mdemir63]

Hocam merhaba

ben anlatamadım; şimdi iki listede de aynı isimler varsa onları eleyip diğer kalanları listeleyebilirmiyiz diye sormak istemiştim. Galiba hocam bu defa anlatabildim.

Saygılar Hocam

 

[Orion1]

Hocam merhaba

ben anlatamadım; şimdi iki listede de aynı isimler varsa onları eleyip diğer kalanları listeleyebilirmiyiz diye sormak istemiştim. Galiba hocam bu defa anlatabildim.

Saygılar Hocam

Bende diyorum zaten kodlar öyle çalışıyor.Siz öyle çalışmıyor diyorsanız listelenenlerden benzer olanları dosya üzerinde işaretleyip dosyayı ekleyin ben bakayım.Ama dikkat edin bire bir ayni olması lazım.

 

[Mdemir63]

Hocam Çok özür dilerim doğru söylüyorsunuz zaten kodlar öyle çalışıyor.

evet hocam özür dileyerek şunu sormak istiyorum. Bir nevi toplama gibi düşünecek olursak; 2 listedeki aynı isimleri teke indirgeyerek tek liste nasıl alabiririz? (Yani aynı isimlerin bir tanesini alarak liste yapmak)

Saygılar

 

[Orion1]

Hocam Çok özür dilerim doğru söylüyorsunuz zaten kodlar öyle çalışıyor.

evet hocam özür dileyerek şunu sormak istiyorum. Bir nevi toplama gibi düşünecek olursak; 2 listedeki aynı isimleri teke indirgeyerek tek liste nasıl alabiririz? (Yani aynı isimlerin bir tanesini alarak liste yapmak)

Saygılar

Dosyanız ekte.
Benzeyenleri listeliyor.

Sub benzer()
Dim i As Byte, k As Long, a As Long, syf As Byte
Sheets("Sayfa3").Select
Application.ScreenUpdating = False
Range("A2:B65536").Clear
a = 2
For i = 1 To 2
    If i = 1 Then
        syf = 2
        Else
        syf = 1
    End If
    For k = 2 To Sheets(i).Cells(65536, "B").End(xlUp).Row
        If WorksheetFunction.CountIf(Sheets(syf).Range("B2:B65536"), Sheets(i).Cells(k, "B").Value) > 0 Then
            If WorksheetFunction.CountIf(Sheets("Sayfa3").Range("B2:B65536"), Sheets(i).Cells(k, "B").Value) = 0 Then
                Cells(a, "A").Value = a - 1
                Cells(a, "B").Value = Sheets(i).Cells(k, "B").Value
                a = a + 1
            End If
        End If
    Next k
Next i
Application.ScreenUpdating = True
MsgBox "Benzersizler Listelendi..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[Mdemir63]

Hocam hakkınızı helal edin çok emeğiniz geçti

Saygılar sunuyorum

 

[Orion1]

Hocam hakkınızı helal edin çok emeğiniz geçti

Saygılar sunuyorum

Saygılar benden.
iyi çalışmalar.