Sub Karsilastir()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
s3.Range("A2:D65536").ClearContents
Dim i As Long, Sat As Long
Dim Adet As Integer, Durum As Integer
Application.ScreenUpdating = False
s1.Columns("A:D").Interior.ColorIndex = xlNone '----Daha Önce Olan renkleri Kaldır
Sat = 1
For i = 2 To s1.[A65536].End(3).Row
Durum = 0
Set Bul = s2.Columns(1).Find(s1.Cells(i, "A"))
If Bul Is Nothing Then
Durum = 1
Else
If s1.Cells(i, "D") <> s2.Cells(Bul.Row, "D") Then
Durum = 2
End If
End If
If Durum > 0 Then
Sat = Sat + 1
Adet = Adet + 1
s3.Cells(Sat, "A") = s1.Cells(i, "A")
s3.Cells(Sat, "B") = s1.Cells(i, "B")
s3.Cells(Sat, "C") = s1.Cells(i, "C")
s3.Cells(Sat, "D") = s1.Cells(i, "D")
'------------- Renklendirme Başlangıcı -----------------
If Durum = 1 Then
s1.Range("A" & i & ":D" & i).Interior.ColorIndex = 3 '-------- Sicil Numarası Yok
Else
s1.Range("A" & i & ":D" & i).Interior.ColorIndex = 19 '-------- Sicil Numarası Var Tutar Tutmuyor
End If
'------------- Renklendirme Sonu -----------------
End If
Next i
MsgBox " Sayfa2 de Olmayan " & Adet & " Kişi Buldum ......"
s3.Select
End Sub