farlı sayfalardaki bir carinin toplam değerlerinin toplamı

[canerozturk]

Merhaba hocalarım gönderdiğim dosyada listeden isim seçtiğimde karşısında tutarı giriyorum cariler sayfasına doğru şeklide toplanıyor sadece birinci sayafyı yapabiliyorum bu üç sayfanın hangi carinin ne kadar borc ve alacakları toplamı ne kadar yapıyor onu yapmak istiyorum şimiden teşekkürler

 

[canerozturk]

Yardım edecek kimse yokmu

 

[canerozturk]

lütfen birisi yardımcı olsun

 

[canerozturk]

imdatt yardım

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub cari()
Set s1 = Sheets("CARİLER")

For sayfa = 1 To Sheets.Count
If Sheets(sayfa).Name <> s1.Name Then
    For borç = 3 To 33
        eski = WorksheetFunction.Max(3, s1.Cells(Rows.Count, "A").End(3).Row)
        If s1.[A3] = "" Then eski = 2
        If WorksheetFunction.CountIf(s1.Range("A3:A" & eski + 1), Sheets(sayfa).Cells(borç, "C")) = 0 Then
            s1.Cells(eski + 1, "A") = Sheets(sayfa).Cells(borç, "C")
            s1.Cells(eski + 1, "B") = Sheets(sayfa).Cells(borç, "E")
        Else
            For kişi = 3 To eski
                If s1.Cells(kişi, "A") = Sheets(sayfa).Cells(borç, "C") Then
                    s1.Cells(kişi, "B") = s1.Cells(kişi, "B") + Sheets(sayfa).Cells(borç, "E")
                    kişi = eski
                End If
            Next
        End If
    Next
    
     For alacak = 46 To WorksheetFunction.Max(46, Sheets(sayfa).Cells(Rows.Count, "C").End(3).Row)
        eski = WorksheetFunction.Max(3, s1.Cells(Rows.Count, "A").End(3).Row)
        If s1.[A3] = "" Then eski = 2
        If WorksheetFunction.CountIf(s1.Range("A3:A" & eski + 1), Sheets(sayfa).Cells(alacak, "C")) = 0 Then
            s1.Cells(eski + 1, "A") = Sheets(sayfa).Cells(alacak, "C")
            s1.Cells(eski + 1, "C") = Sheets(sayfa).Cells(alacak, "E")
        Else
            For kişi = 3 To eski
                If s1.Cells(kişi, "A") = Sheets(sayfa).Cells(alacak, "C") Then
                    s1.Cells(kişi, "C") = s1.Cells(kişi, "C") + Sheets(sayfa).Cells(alacak, "E")
                    kişi = eski
                End If
            Next
        End If
    Next
End If
Next
yeni = s1.Cells(Rows.Count, "A").End(3).Row
For kalan = 3 To yeni
s1.Cells(kalan, "D") = s1.Cells(kalan, "B") - s1.Cells(kalan, "C")
Next
End Sub

Yalnız kodların düzgün çalışması için dosyanızdaki CARİLER sayfası dışındaki diğer tüm sayfaların örneğinizdeki yapıda olması gerekmektedir. Çünkü kodlar CARİLER sayfası dışındaki tüm sayfaları ayrı ayrı kontrol edip, borç ve alacakları CARİLER sayfasına taşımaktadır.