sayfaları karşılaştır olmayanları listele

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
198
Excel Vers. ve Dili
office 2010
Altın Üyelik Bitiş Tarihi
08-12-2027
sayfaları karşılastır . olmayanları sayfaya listele yaklaşık 5000 satır veri var. kısaltılmıştır. yardımcı olursanız sevinirim
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Hangi sütunlar karşılaştırılacak?
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Dim veri1(), veri2(), i&, sat&
    Set s1 = Sheets("Çekilen Veriler")
    Set s2 = Sheets("Karşılaştırılacak_Veri")
    Set s3 = Sheets("Degisen_Tespit")

    veri1 = s1.Range("A1").CurrentRegion.Value
    veri2 = s2.Range("A1").CurrentRegion.Value
    sat = 2
    s3.Range("A2:F" & Rows.Count).Clear

    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(veri1)
            .Item(veri1(i, 2)) = i
        Next i

        For i = 2 To UBound(veri2)
            If .exists(veri2(i, 2)) Then
                .Remove (veri2(i, 2))
            Else
                s3.Cells(sat, 1).Resize(, 6).Value = s2.Cells(i, 1).Resize(, 6).Value
                sat = sat + 1
            End If
        Next i
        If .Count > 0 Then
            itm = .items
            For Each itm In .items
                s3.Cells(sat, 1).Resize(, 6).Value = s1.Cells(itm, 1).Resize(, 6).Value
                s3.Cells(sat, 1).Resize(, 6).Font.Color = vbRed
            Next itm
        End If
    End With
End Sub
 
Üst