Belge Karşılaştırma

[Harun_Y]

Merhaba Değerli üstatlarım;
Siteyi araştırdım ama sorunumda tam istediğim sonuca ulaşamadım. Yardımcı olabilirseniz sevinirim.
Ekteki dosyada iki sekme var. Bunlardan biri “yeni” yazan sürekli güncelleniyor. Yapmak istediğim “eski” ve “yeni” yazan sekmelerin karşılaştırılıp “analiz” yazan sekmeye sadece değişiklik olanların aktarılması. Örnek olarak değişiklik olanı “yeni” de kırmızı ve maviyle belirttim. Şimdiden teşekkür ederim.

 

[veyselemre]

Sub test()

    Dim veriEski, veriYeni, sAnaliz As Worksheet, _
    sat&, i&, ii%, sicil, ls, lst, aktar As Boolean
            
    With Sheets("Eski")
        veriEski = .Range("A2", .Cells(Rows.Count, "F").End(3)).Value
    End With

    With Sheets("Yeni")
        veriYeni = .Range("A2", .Cells(Rows.Count, "F").End(3)).Value
    End With
  
    Set sAnaliz = Sheets("Analiz")
    sAnaliz.Cells.Clear
    Sheets("Eski").Range("A1:F1").Copy sAnaliz.Range("A1")
    Sheets("Yeni").Range("A1:F1").Copy sAnaliz.Range("G1")
    
    sat = 2
    With CreateObject("Scripting.Dictionary")
        For i = LBound(veriEski) To UBound(veriEski)
            .Item(veriEski(i, 2)) = i
        Next i
    
        For i = LBound(veriYeni) To UBound(veriYeni)
            sicil = veriYeni(i, 2)
            
            If .exists(sicil) Then
                aktar = False
                For ii = LBound(veriEski, 2) To UBound(veriEski, 2)
                    If veriEski(.Item(sicil), ii) <> veriYeni(i, ii) Then
                        aktar = True
                        Exit For
                    End If
                Next ii
                If aktar Then
                    For ii = 1 To 6
                        sAnaliz.Cells(sat, ii).Value = veriEski(.Item(sicil), ii)
                        sAnaliz.Cells(sat, ii + 6).Value = veriYeni(i, ii)
                        If veriEski(.Item(sicil), ii) <> veriYeni(i, ii) Then
                            sAnaliz.Cells(sat, ii + 6).Font.Color = vbRed
                        End If
                    Next ii
                    sat = sat + 1
                End If
                .Remove (sicil)
            Else
                For ii = 1 To 6
                    sAnaliz.Cells(sat, ii + 6).Value = veriYeni(i, ii)
                    sAnaliz.Cells(sat, ii + 6).Font.Color = vbBlue
                Next ii
                sat = sat + 1
            End If

        Next i
            
        If .Count > 0 Then
            lst = .items
            For Each ls In lst
                For ii = LBound(veriEski, 2) To UBound(veriEski, 2)
                    sAnaliz.Cells(sat, ii).Value = veriEski(ls, ii)
                    sAnaliz.Cells(sat, ii).Font.Color = vbBlue
                Next ii
                sat = sat + 1
            Next
        
        End If
    
    End With
End Sub

 

[Harun_Y]

Sub test()

    Dim veriEski, veriYeni, sAnaliz As Worksheet, _
    sat&, i&, ii%, sicil, ls, lst, aktar As Boolean
           
    With Sheets("Eski")
        veriEski = .Range("A2", .Cells(Rows.Count, "F").End(3)).Value
    End With

    With Sheets("Yeni")
        veriYeni = .Range("A2", .Cells(Rows.Count, "F").End(3)).Value
    End With
 
    Set sAnaliz = Sheets("Analiz")
    sAnaliz.Cells.Clear
    Sheets("Eski").Range("A1:F1").Copy sAnaliz.Range("A1")
    Sheets("Yeni").Range("A1:F1").Copy sAnaliz.Range("G1")
   
    sat = 2
    With CreateObject("Scripting.Dictionary")
        For i = LBound(veriEski) To UBound(veriEski)
            .Item(veriEski(i, 2)) = i
        Next i
   
        For i = LBound(veriYeni) To UBound(veriYeni)
            sicil = veriYeni(i, 2)
           
            If .exists(sicil) Then
                aktar = False
                For ii = LBound(veriEski, 2) To UBound(veriEski, 2)
                    If veriEski(.Item(sicil), ii) <> veriYeni(i, ii) Then
                        aktar = True
                        Exit For
                    End If
                Next ii
                If aktar Then
                    For ii = 1 To 6
                        sAnaliz.Cells(sat, ii).Value = veriEski(.Item(sicil), ii)
                        sAnaliz.Cells(sat, ii + 6).Value = veriYeni(i, ii)
                        If veriEski(.Item(sicil), ii) <> veriYeni(i, ii) Then
                            sAnaliz.Cells(sat, ii + 6).Font.Color = vbRed
                        End If
                    Next ii
                    sat = sat + 1
                End If
                .Remove (sicil)
            Else
                For ii = 1 To 6
                    sAnaliz.Cells(sat, ii + 6).Value = veriYeni(i, ii)
                    sAnaliz.Cells(sat, ii + 6).Font.Color = vbBlue
                Next ii
                sat = sat + 1
            End If

        Next i
           
        If .Count > 0 Then
            lst = .items
            For Each ls In lst
                For ii = LBound(veriEski, 2) To UBound(veriEski, 2)
                    sAnaliz.Cells(sat, ii).Value = veriEski(ls, ii)
                    sAnaliz.Cells(sat, ii).Font.Color = vbBlue
                Next ii
                sat = sat + 1
            Next
       
        End If
   
    End With
End Sub

Çok teşekkür ederim ustam sağol