iki sütun karşılaştırıp farklı olanları filtreleme

[quixotic79]

Merhaba arkadaşlar excel sayfamızda 3 sekme var sekme birin a sütunundaki tüm değerler ile sekme2 nin a sütunundaki tüm değerleri karşılaştırıp. karşılaştırma sonucu Sekme2 deki aynı olan değerleri sekme1'in a sütunundan çıkararak sekme3 ün a sütununa yazmasını istiyorum. Yani özetle 2 sütunu karşılaştırıp 2.sindeki değerleri eleyerek başka bir sekmeye yazmak istiyorum yardımlarınız için şimdiden teşekkürler. Örnek dosyayı eke bırakıyorum.[URL=https://dosya.co/bdm9tywf6w3u/deneme.xlsx.html]deneme.xlsx - 12 KB[/URL]

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodları bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Range
    Dim Bul As Range
    Dim Sira As Integer
    For Each Bak In Worksheets("Sekme1").Range("A1:A" & Worksheets("Sekme1").Cells(Rows.Count, "A").End(xlUp).Row)
        Set Bul = Worksheets("Sekme2").Range("A:A").Find(what:=Bak, LookAt:=xlWhole)
        If Bul Is Nothing Then
            Sira = Worksheets("Sekme3").Cells(Rows.Count, "A").End(xlUp).Row
            If Worksheets("Sekme3").Range("A1") <> "" Then Sira = 1 + Sira
            Worksheets("Sekme3").Range("A" & Sira) = Bak
        End If
    Next
End Sub

 

[alicimri]

Alternatif

Sub aktar()
say = 1
For i = 1 To Worksheets("Sekme1").Cells(Cells.Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIf(Worksheets("Sekme2").Columns(1), Worksheets("Sekme1").Cells(i, 1)) = 1 Then
Worksheets("Sekme3").Cells(say, 1).Value = Worksheets("Sekme1").Cells(i, 1)
say = say + 1
End If
Next
End Sub

 

[quixotic79]

Merhaba.

Aşağıdaki kodları bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Range
    Dim Bul As Range
    Dim Sira As Integer
    For Each Bak In Worksheets("Sekme1").Range("A1:A" & Worksheets("Sekme1").Cells(Rows.Count, "A").End(xlUp).Row)
        Set Bul = Worksheets("Sekme2").Range("A:A").Find(what:=Bak, LookAt:=xlWhole)
        If Bul Is Nothing Then
            Sira = Worksheets("Sekme3").Cells(Rows.Count, "A").End(xlUp).Row
            If Worksheets("Sekme3").Range("A1") <> "" Then Sira = 1 + Sira
            Worksheets("Sekme3").Range("A" & Sira) = Bak
        End If
    Next
End Sub

çok teşekkür ederim uyguladım. Fakat küçücük bir sorun var o da sadece sekme2 nin a1 hücresindeki değeri çıkartıp geri kalanı listeliyor. Ben sekme2 nin A sütununda aşağıya doğru her değeri süzsün istiyorum...

 

[quixotic79]

Alternatif

Sub aktar()
say = 1
For i = 1 To Worksheets("Sekme1").Cells(Cells.Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIf(Worksheets("Sekme2").Columns(1), Worksheets("Sekme1").Cells(i, 1)) = 1 Then
Worksheets("Sekme3").Cells(say, 1).Value = Worksheets("Sekme1").Cells(i, 1)
say = say + 1
End If
Next
End Sub

ilginize teşekkür ederim sizin kodu çalıştırdığımda direkt sekme2 de a1 hücresinde bulunan değeri alıp sekme 3 a1 hücresine aktarıyor. Yapmak istediğim şey sekme1 ve sekme2 yi karşılaştırıp sekme2 a sütununda bulanan değerleri sekme1 a sütunundakilerden çıkarak geri kalanları sekme3 a sütununa yerleştirmesi.

 

[quixotic79]

çok teşekkür ederim uyguladım. Fakat küçücük bir sorun var o da sadece sekme2 nin a1 hücresindeki değeri çıkartıp geri kalanı listeliyor. Ben sekme2 nin A sütununda aşağıya doğru her değeri süzsün istiyorum...

özür dilerim hata bende imiş çok teşekkür ediyorum.... oldu sanırım.