Tablo Karşılaştırma İle İlgili Komplike Bir soru...!

[dragonflyvtr]

Merhabalar Temelde İki tablo karşılaştırma problemi ama bir iki seçenekli Beki çok komplike diye kimse uğraşmak istemeyebilir.
Ekteki tabloda notlar mevcut ama
1.Bir satırda iki satır AP tablosunda tek satırda kontrol edip toplam eşit ise bu iki satırı silmesi lazım
2.Bir satırda Ap tablosunda farklı Bunu da ya fark var diye uyarması yada baska bir tabloya atması lazım
3.Bir satırda Tarih farklı olduğu için ayrıca fark uyarısı vermesi lazım sadece açıklama farklı olabilir geriye kalan satırlar farklı olmaması lazım olanlarda uyarı vermesi gerekiyor.
Şimdiden Tüm Emeği geçenlere teşekkürler.

 

[Ömer BARAN]

Merhaba.

Belgeye Sayfa1 adıyla boş bir sayfa ekleyin, ardından aşağıdaki kod'u boş bir MODÜL'e yapıştırın ve çalıştırın.
.

[FONT="Arial Narrow"][B]Sub AYRIŞTIR_BRN()[/B]
Set ap = Sheets("AP Tablosu"): Set gi = Sheets("Gl Tablosu")
Set s1 = Sheets("[B][COLOR="Red"]Sayfa1[/COLOR][/B]"): Set wf = Application.WorksheetFunction
s1.Cells.ClearContents: s1.Cells.Interior.Color = xlNone: gi.Range("A1:E1").Copy s1.[A1]
For apsat = ap.[A65536].End(3).Row To 2 Step -1
    adet = wf.CountIf(gi.Range("B:B"), ap.Cells(apsat, "B"))
    If adet = 0 Then ap.Cells(apsat, "F") = "[COLOR="blue"]Gl sayfasında YOK[/COLOR]"
    If adet > 0 Then
    gisat = wf.Match(ap.Cells(apsat, "B"), gi.Range("B:B"), 0)
        If ap.Cells(apsat, 1) = gi.Cells(gisat, 1) And ap.Cells(apsat, 2) = gi.Cells(gisat, 2) And _
            ap.Cells(apsat, 3) = gi.Cells(gisat, 3) And ap.Cells(apsat, 4) = gi.Cells(gisat, 4) And _
            ap.Cells(apsat, 5) = gi.Cells(gisat, 5) Then
            gi.Rows(gisat).Delete Shift:=xlUp
            ap.Range(ap.Cells(apsat, 1), ap.Cells(apsat, 5)).Interior.Color = vbYellow
        ElseIf ap.Cells(apsat, 1) <> gi.Cells(gisat, 1) And ap.Cells(apsat, 2) = gi.Cells(gisat, 2) And _
            ap.Cells(apsat, 4) = gi.Cells(gisat, 4) And ap.Cells(apsat, 5) = gi.Cells(gisat, 5) Then
            gi.Cells(gisat, "F") = "TARİH FARKLI": ap.Cells(apsat, "F") = "[COLOR="Blue"]TARİH FARKLI Gl Sayfasına bakınız.[/COLOR]"
        ElseIf wf.SumIf(gi.Range("B:B"), ap.Cells(apsat, 2), gi.Range("E:E")) = ap.Cells(apsat, "E") Then
            gi.Rows(gisat & ":" & gisat + adet - 1).Delete Shift:=xlUp
            ap.Range(ap.Cells(apsat, 1), ap.Cells(apsat, 5)).Interior.Color = vbYellow
        End If: End If: Next
For git = gi.[A65536].End(3).Row To 2 Step -1
    If gi.Cells(git, "F") = "" Then
    gi.Range(gi.Cells(git, "A"), gi.Cells(git, "E")).Copy s1.Cells(s1.[A65536].End(3).Row + 1, "A")
    ap.Cells(wf.Match(gi.Cells(git, 2), ap.Range("B:B"), 0), "F") = "[COLOR="blue"]FARK var, Sayfa1'e aktarıldı.[/COLOR]"
    gi.Rows(git).Delete Shift:=xlUp: End If: Next
s1.Columns("A:E").AutoFit: MsgBox "İŞLEM TAMAM"
[B]End Sub[/B][/FONT]

 

[dragonflyvtr]

Çok Teşekkürler

Ömer Bey teşekkür ederim ancak bu gün deneybildim hakikatten güzel olmuş sadece bir soru ekleyebilirim buna tabloda baska sutunlar da var ben gereksiz diye eklemedim ancak verileri kullanımda onlarda olacak kolonlarda yazdığınız kodu incelediğimde bir iki yere kolon kadar referans hücreyi yazarsam değişmez gibi sizce de doğru mu ? Kırmızı işaretledim

Sub AYRIŞTIR_BRN()
Set ap = Sheets("AP Tablosu"): Set gi = Sheets("Gl Tablosu")
Set s1 = Sheets("Sayfa1"): Set wf = Application.WorksheetFunction
s1.Cells.ClearContents: s1.Cells.Interior.Color = xlNone: gi.Range("A1:E1").Copy s1.[A1]
For apsat = ap.[A65536].End(3).Row To 2 Step -1
adet = wf.CountIf(gi.Range("B:B"), ap.Cells(apsat, "B"))
If adet = 0 Then ap.Cells(apsat, "F") = "Gl sayfasında YOK"
If adet > 0 Then
gisat = wf.Match(ap.Cells(apsat, "B"), gi.Range("B:B"), 0)
If ap.Cells(apsat, 1) = gi.Cells(gisat, 1) And ap.Cells(apsat, 2) = gi.Cells(gisat, 2) And _
ap.Cells(apsat, 3) = gi.Cells(gisat, 3) And ap.Cells(apsat, 4) = gi.Cells(gisat, 4) And _
ap.Cells(apsat, 5) = gi.Cells(gisat, 5) Then
gi.Rows(gisat).Delete Shift:=xlUp
ap.Range(ap.Cells(apsat, 1), ap.Cells(apsat, 5)).Interior.Color = vbYellow
ElseIf ap.Cells(apsat, 1) <> gi.Cells(gisat, 1) And ap.Cells(apsat, 2) = gi.Cells(gisat, 2) And _
ap.Cells(apsat, 4) = gi.Cells(gisat, 4) And ap.Cells(apsat, 5) = gi.Cells(gisat, 5) Then
gi.Cells(gisat, "F") = "TARİH FARKLI": ap.Cells(apsat, "F") = "TARİH FARKLI Gl Sayfasına bakınız."
ElseIf wf.SumIf(gi.Range("B:B"), ap.Cells(apsat, 2), gi.Range("E:E")) = ap.Cells(apsat, "E") Then
gi.Rows(gisat & ":" & gisat + adet - 1).Delete Shift:=xlUp
ap.Range(ap.Cells(apsat, 1), ap.Cells(apsat, 5)).Interior.Color = vbYellow
End If: End If: Next
For git = gi.[A65536].End(3).Row To 2 Step -1
If gi.Cells(git, "F") = "" Then
gi.Range(gi.Cells(git, "A"), gi.Cells(git, "E")).Copy s1.Cells(s1.[A65536].End(3).Row + 1, "A")
ap.Cells(wf.Match(gi.Cells(git, 2), ap.Range("B:B"), 0), "F") = "FARK var, Sayfa1'e aktarıldı."
gi.Rows(git).Delete Shift:=xlUp: End If: Next
s1.Columns("A:E").AutoFit: MsgBox "İŞLEM TAMAM"
End Sub