Makronun devamı ?

[tahsinanarat]

Sitede yayınlanan bütün kod bankalarında ;
A ile b'yi karşılaştır, aynı olanları c'ye, farklı olanları d'ye yaz...
şeklinde bir kod bulunmakta, ancak kod tam olarak yapıştırılmamış, başlığından da anlaşıldığı üzere sıkça sorulan sorulara cevap olabileceğinden

Sub bul()
For a = 2 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Columns(1), Cells(a, 2).Value) = 0 Then
e = WorksheetFunction.CountA([d2:d65536]) + 1
Cells(e + 1, 4) = Cells(a, 2).Value
End If
If WorksheetFunction.CountIf(Columns(2.......................
bu kodun devamı nasıl olmalıdır.

 

[tahsinanarat]

Sn. korhan hocam, aynı sayfadaki a ve b sutunlarını karşılaştırıp aynı olanları c'ye, farklı olanları d'ye yazdıracak kodlar nasıl yazılabilir, yada yukarıdaki kodu nasıl devam ettirebiliriz. Saygılarımla.

 

[veyselemre]

A ve B sütunlarını karşılaştıran bir örnek.

Sub aVeBSutunlariniKarsilastir()
    Application.ScreenUpdating = False
    Range("C2:E65536").ClearContents

    sonA = [A65536].End(3).Row
    sonB = [B65536].End(3).Row

    Range("AA2:AA" & sonA).Formula = "=countif(B$2:B$" & sonB & ",A2)"
    Range("AB2:AB" & sonB).Formula = "=countif(A$2:A$" & sonA & ",B2)"

    sat = 2
    sat2 = 2
    For x = 2 To sonA
        If Cells(x, "AA") = 1 Then Cells(sat, "C") = Cells(x, "A"): sat = sat + 1    'ortak olanlar
        If Cells(x, "AA") = 0 And Cells(x, "A") <> "" Then Cells(sat2, "D") = Cells(x, "A"): sat2 = sat2 + 1    'Sadece A'da Olanlar
    Next x

    sat = 2
    For x = 2 To sonB
        If Cells(x, "AB") = 0 And Cells(x, "B") <> "" Then Cells(sat, "E") = Cells(x, "B"): sat = sat + 1    ''Sadece B'de Olanlar
    Next x

    Range("AA2:AB65536").ClearContents
    Application.ScreenUpdating = True
End Sub

 

[Ayhan Ercan]

Merhaba

Alternatif olarak, biraz değişik ama işe yarar...


Aynı olan verilerin hücreleri renklendiriliyor ve c sütununa yazılıyor
Aynı olmayan veriler d sütununa yazılıyor...

Dim hcr As Range
c = [c65536].End(3).Row + 1
d = [d65536].End(3).Row + 1
For a = 2 To [A65536].End(3).Row
    For b = 2 To [B65536].End(3).Row
        If Cells(a, 1) = Cells(b, 2) Then
            Cells(c, 3) = Cells(a, 1)
            c = c + 1
            Cells(a, 1).Interior.ColorIndex = 6
            Cells(b, 2).Interior.ColorIndex = 6
        End If
    Next
Next
For Each hcr In Range("a2:b" & [B65536].End(3).Row)
    If hcr.Interior.ColorIndex = xlNone Then
        Cells(d, 4) = hcr
        d = d + 1
    End If
Next

 

[tahsinanarat]

Her ikiside birbirinden güzel, çok teşekkürler ediyorum sn. üstadlarım. Kolay gelsin.