• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

iki ayrı sayfadaki cari hesapların farklısını bulma

Katılım
12 Mart 2014
Mesajlar
21
Excel Vers. ve Dili
2013
Slm, ekde gönderdiğim excelde ''eski'' isimli sayfada borç sütununda bulunan sayıların ''yeni'' isimli sayfadaki borç sutununda bulunan sayılarla hesap bazında kıyaslanıp hem eskide hem de yenide diğer sayfada olmayan sayıyı hata olarak görüp sarıya boyayacak bir makro programı istiyorum. Aynı işlemleri alacak sutunun da da yapacak.örnek:eski sayfasında 135.001.0009.000.000
hesap skontu borç bakiyeleri içinde olupta yeni sayfasında 135.001.0009.000.000
hesap skontu borç sutununda ki bakiyelerde olmayan rakamı sarıya boyasın.iki taraftada olmayanları bulsun.Birde ''0'' rakamını hata hata olarak görmesin.
Çok teşekkür ederim iyi çalışmalar.
 

Ekli dosyalar

Son düzenleme:
Aşağıdaki kodu dener misiniz?
Kod:
Sub KarşılaştırBoya()
Dim hesap(1 To 50000)
Set e = Sheets("eski")
Set y = Sheets("yeni")
e.Range("B:B").Interior.ColorIndex = 0
y.Range("B:B").Interior.ColorIndex = 0

For i = 2 To e.[A65500].End(3).Row
    If e.Cells(i, 1) <> e.Cells(i - 1, 1) Then
        say = say + 1
        hesap(say) = e.Cells(i, 1)
    End If
Next i

For j = 1 To say

    For a = 1 To e.[A65500].End(3).Row
        If e.Cells(a, 1) = hesap(j) Then ilke = e.Cells(a, 1).Row: GoTo b:
    Next a
b:
    For b = e.[A65500].End(3).Row To 1 Step -1
        If e.Cells(b, 1) = hesap(j) Then sone = e.Cells(b, 1).Row: GoTo c:
    Next b
c:
    For c = 1 To y.[A65500].End(3).Row
        If y.Cells(c, 1) = hesap(j) Then ilky = e.Cells(c, 1).Row: GoTo d:
    Next c
d:
    For d = y.[A65500].End(3).Row To 1 Step -1
        If y.Cells(d, 1) = hesap(j) Then sony = e.Cells(d, 1).Row: GoTo m:
    Next d
m:
    For m = ilke To sone
        borç = e.Cells(m, 2)
        borç1 = WorksheetFunction.CountIf(e.Range("B" & ilke & ":B" & m), borç)
        borç2 = WorksheetFunction.CountIf(y.Range("B" & ilky & ":B" & sony), borç)
        If borç1 > borç2 And e.Cells(m, 2) <> 0 Then e.Cells(m, 2).Interior.ColorIndex = 6
        
        alacak = e.Cells(m, 3)
        alacak1 = WorksheetFunction.CountIf(e.Range("B" & ilke & ":B" & m), alacak)
        alacak2 = WorksheetFunction.CountIf(y.Range("B" & ilky & ":B" & sony), alacak)
        If alacak1 > alacak2 And e.Cells(m, 3) <> 0 Then e.Cells(m, 3).Interior.ColorIndex = 6
    Next m
    
    For n = ilky To sony
        borç = y.Cells(n, 2)
        borç1 = WorksheetFunction.CountIf(y.Range("B" & ilky & ":B" & n), borç)
        borç2 = WorksheetFunction.CountIf(e.Range("B" & ilke & ":B" & sone), borç)
        If borç1 > borç2 And y.Cells(n, 2) <> 0 Then y.Cells(n, 2).Interior.ColorIndex = 6
        
        alacak = y.Cells(n, 3)
        alacak1 = WorksheetFunction.CountIf(y.Range("B" & ilky & ":B" & n), alacak)
        alacak2 = WorksheetFunction.CountIf(e.Range("B" & ilke & ":B" & sone), alacak)
        If alacak1 > alacak2 And y.Cells(n, 3) <> 0 Then y.Cells(n, 3).Interior.ColorIndex = 6
    Next n
    
Next j
End Sub
 
Slm, Sayın mucit77 bunu excel sayfasında yapmayı bilmiyorum.Ya nasıl yapacağımı yazarsanız ya da örnek sayfa koyarsanız çok sevinirim.İyi çalışmalar.
 
Tamam Mucit hocam Admin Hüseyin Hocanın videolarını izleyerek makroyu eklemeyi biraz öğrendim, uyguladım, oldu sanırım. işyerinde de test edip kullanacağım. Sorun çıkarsa dönüş yaparım elinize sağlık.
 
Sayın mucit77 harika çalışıyor kodlar.Elinize sağlık,çok işime yaradı.
 
Yardımcı olabildiysek ne mutlu...
İyi çalışmalar...
 
Geri
Üst