sütunları karşılaştırmak

[gencoglu27]

Merhaba arkadaşlar,

A sütünunda yüzlerce isim ,B sütununda da yüzlerce isim var. Fakat her 60 yada 80 satırda her iki sütundaki bir isim benzer olmakta..
elma-armut
kavun-muz
nar-nohut
....
...
...
incir-incir
üzüm-portakal
..gibi sıralanmakta ve incir-incir isimleri benzemekte ve ben bunları listeden çıkartmak istiyorum..

yardımcı olur musunuz ?
teşekkürler

 

[Mustafa MUTLU]

Sub benzersizler()
Dim sat As Integer, s As Integer
Range("c1:c" & Rows.Count).ClearContents
s = 1
For sat = 1 To Cells(Rows.Count, "a").End(xlUp).Row
If WorksheetFunction.CountIf(Range("b1:b" & sat), Cells(sat, "a")) = 0 Then
Cells(s, "c") = Cells(sat, "a").Value
s = s + 1
End If
Next
End Sub

Bu Kodla A sütununda olup B Sütunundada olanları almadan
C sütununa sıralayabilirsin

N.Ziya Hiçdurmaz dan alınmıştır.

 

[gencoglu27]

Değerli Mustafa Mutlu yanıtlamış.. Teşekkürler Fakat sadece "A" da benzer olmayanları C ye kopyalamış...Hem A yı hemde B yı C ve D ye kopyalasak iyi olurdu. Yani A yı C ye B yi D ye kopyalamak gibi bir çözüm lazım.. Ekte dosyam var..Bakarsanız sevinirim.

Teşekkürler.

 

[gencoglu27]

Tamam böyle yaptım oldu..:bravo:.birazcık VB kurcalamıştım..:redface:Teşekkürler

Sub benzersizler()
Dim sat As Integer, s As Integer, m As Integer, sat2 As Integer

Range("c1:c" & Rows.Count).ClearContents
Range("d1:d" & Rows.Count).ClearContents
s = 1
m = 1
For sat = 1 To Cells(Rows.Count, "a").End(xlUp).Row
If WorksheetFunction.CountIf(Range("b1:b" & sat), Cells(sat, "a")) = 0 Then
Cells(s, "c") = Cells(sat, "a").Value
s = s + 1
End If
Next
For sat2 = 1 To Cells(Rows.Count, "b").End(xlUp).Row
If WorksheetFunction.CountIf(Range("a1:a" & sat2), Cells(sat2, "b")) = 0 Then
Cells(m, "d") = Cells(sat2, "b").Value
m = m + 1
End If
Next

End Sub

Fakat ..1000 satırdan fazlasına OVERFLOW hatası veriyor