Mükerrer kayıt sorunu

[oornek1]

Arkadaşlar örnek dosyada liste bir ve liste iki var ordaki kayıtlarda 1.liste olan kayıtları 2. listede var ise sayfa2 ye yazdırmali ve aynı sayfada olan 1. liste olan 2.listede olmayanları sayfa3 e listelemesi örnek dosya ektedir.

 

[İhsan Tank]

Merhaba
2 soru sormuşsunuz ikiside aynı nasıl olacak daha net bilgiler verirseniz yardımcı olamaya çalışacağım.

 

[oornek1]

1.soru: 1.listede olan kayıtlar 2.listede var ise olan kayıtlar sayfa2 ye yazdırılması,
örnek;
1.listede 120 satırda omer olsun 2. listede omer var ise sayfa ikiye yazdırılsın yok ise sayfa3' e yazdırılsın,

 

[oornek1]

Cumanız Mübarek Olsun;

Merhaba
2 soru sormuşsunuz ikiside aynı nasıl olacak daha net bilgiler verirseniz yardımcı olamaya çalışacağım.

Hocam soruyu düzenledim

1.soru: 1.listede olan kayıtlar 2.listede var ise olan kayıtlar sayfa2 ye yazdırılması,
örnek;
2.soru: 1.listede 120 satırda omer olsun 2. listede omer var ise sayfa ikiye yazdırılsın yok ise sayfa3' e yazdırılsın,

 

[İhsan Tank]

1.soru: 1.listede olan kayıtlar 2.listede var ise olan kayıtlar sayfa2 ye yazdırılması,
örnek;
1.listede 120 satırda omer olsun 2. listede omer var ise sayfa ikiye yazdırılsın yok ise sayfa3' e yazdırılsın,

Merhaba
Boş bir module kopyalayın ve deneyin

Option Explicit
Sub ayır_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim s1, s2, s3
trabzonspor = MsgBox("Olan ve Olmayanı Ayırıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
s2.Range("A:A").ClearContents
s3.Range("A:A").ClearContents
kaplan = s2.Range("A" & Rows.Count).End(xlUp).Row
trabzonspor = s3.Range("A" & Rows.Count).End(xlUp).Row
For ts = 2 To s1.Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("B:B"), s1.Cells(ts, "A")) > 0 Then
s2.Range("A" & kaplan + 1) = s1.Cells(ts, "A")
kaplan = kaplan + 1
Else
s3.Range("A" & trabzonspor + 1) = s1.Cells(ts, "A")
trabzonspor = trabzonspor + 1
End If
Next
kaplan = s2.Range("A" & Rows.Count).End(xlUp).Row
trabzonspor = s3.Range("A" & Rows.Count).End(xlUp).Row
For ts = 2 To s1.Cells(Rows.Count, "B").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("A:A"), s1.Cells(ts, "B")) > 0 Then
s2.Range("A" & kaplan + 1) = s1.Cells(ts, "B")
kaplan = kaplan + 1
Else
s3.Range("A" & trabzonspor + 1) = s1.Cells(ts, "B")
trabzonspor = trabzonspor + 1
End If
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Olan ve Olmayanı Ayırdım", , "Btiş"
End Sub