Makrolar la karşılaştırma

[suphi75]

Hayırlı Cuma'lar arkadaşlar.

Üzerinde bikaç gündür çalıştığım bir makro var ama bir türlü işin içinden çıkamadım. Bu konuda bana yardımcı olursanız sevinirim. Belki de döngüyü kuramadığımdan sorun oluyordur. Elimde iki tablo var. İlk tablodaki verileri karşılaştırıp aynı olanların farkını alacak, aynısı yoksa farklı bir yere yazacak.Fakat bir türlü işin içinden çıkamadım.

Ekte tabloyu gönderiyorum. Üstad lar yardımcı olursanız müteşekkir kalırım.

Arkadaşlar soruna çözüm bulan oldumu?

 

[suphi75]

arkadaşlar soruna çözüm bulabilen varmı. Makro şart değil fonksiyonlar ilede yol gösterirseniz ben uğraşırım.

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub Raporla()
Dim durum As Boolean
Set s1 = Sheets("REESKONT")
Set s2 = Sheets("GİREN")
Set s3 = Sheets("ÇIKAN")
Set s4 = Sheets("FARK")
s2.Range("A2:E1500").ClearContents
s3.Range("A2:E1500").ClearContents
s4.Range("A2:E1500").ClearContents
For i = 2 To s1.[a65536].End(3).Row
durum = False
    For j = 2 To s1.[g65536].End(3).Row
        If s1.Cells(i, "a") = s1.Cells(j, "g") And s1.Cells(i, "c") = s1.Cells(j, "I") And s1.Cells(i, "d") = s1.Cells(j, "j") Then
            durum = True
            sat = s4.[a65536].End(3).Row + 1
            s4.Cells(sat, "a").Value = s1.Cells(i, "a").Value
            s4.Cells(sat, "b").Value = s1.Cells(i, "b").Value - s1.Cells(j, "h").Value
            s4.Cells(sat, "c").Value = s1.Cells(i, "c").Value
            s4.Cells(sat, "d").Value = s1.Cells(i, "d").Value
            s4.Cells(sat, "e").Value = s1.Cells(i, "e").Value
        End If
    Next j
    '**********************************************
    If durum = False Then
        sat = s2.[a65536].End(3).Row + 1
        s2.Cells(sat, "a").Value = s1.Cells(i, "a").Value
        s2.Cells(sat, "b").Value = s1.Cells(i, "b").Value
        s2.Cells(sat, "c").Value = s1.Cells(i, "c").Value
        s2.Cells(sat, "d").Value = s1.Cells(i, "d").Value
        s2.Cells(sat, "e").Value = s1.Cells(i, "e").Value
    End If
    '**********************************************
Next i
For i = 2 To s1.[g65536].End(3).Row
durum = False
    For j = 2 To s1.[a65536].End(3).Row
        If s1.Cells(i, "g") = s1.Cells(j, "a") And s1.Cells(i, "I") = s1.Cells(j, "c") And s1.Cells(i, "j") = s1.Cells(j, "d") Then
            durum = True
        End If
    Next j
    '**********************************************
    If durum = False Then
        sat = s3.[a65536].End(3).Row + 1
        s3.Cells(sat, "a").Value = s1.Cells(i, "g").Value
        s3.Cells(sat, "b").Value = s1.Cells(i, "h").Value
        s3.Cells(sat, "c").Value = s1.Cells(i, "I").Value
        s3.Cells(sat, "d").Value = s1.Cells(i, "j").Value
        s3.Cells(sat, "e").Value = s1.Cells(i, "k").Value
    End If
    '**********************************************
Next i
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
Set s3 = Nothing
Set s4 = Nothing
End Sub

 

[suphi75]

Sayın ripek çok teşekkür ediyorum. Size zahmet verdim. Sağolun varolun.