Firma Adına Göre Borç/Alacak Toplamı Bulma Hk.

[By_eyicaN]

Merhaba;
Son birkaç gündür forumda araştırdım, yakın cevaplar olsa da tam cevap niteliğinde bir konu bulamadım. Belki bir kaç farklı konudan kod birleştirerek cevap bulabilirdim ama excel'de Makro konusunda pek bilgi sahibi olmadığımdan dolayı açıkçası beceremedim.

Sayfa1'de uzunca bir firma listem var. yapmak istediğim işlem sayfa1'deki bu firmaların(G2:G) toplam borç(H2:H) ve kalan(I2:I) miktarlarını görmek için Sayfa2'de listelemek istiyorum.
Ekteki dosyada yapmak istediğim işlemi manuel olarak yaptım, buna göre bir makro kodu için yardımlarınızı beklemekteyim..
Şimdiden teşekkürler..

 

[Ömer]

Merhaba,

Excelin kendi özelliklerinde olan "Özet tablo" seçeneğini kullanmanızı tavsiye ederim.

ÖZET TABLOLAR (PİVOT TABLE)

 

[burock1034]

Buyrun , istediğiniz üzere düzenledim ve sarı ile renklendirdim düzenlediğim noktayı.

 

[By_eyicaN]

Merhaba,

Excelin kendi özelliklerinde olan "Özet tablo" seçeneğini kullanmanızı tavsiye ederim.

ÖZET TABLOLAR (PİVOT TABLE)

Özet tablo kullanıyorum fakat bu dosya ile çalışan arkadaş excele de bilgisayara da fazlasıyla yabancı. o nedenle verilerin doğruluk güvencesi adına arkadaşa göre yani herhangi bir tablolama ya da formül işlemi içermeyen bir tablo yapmak gayesi ile çabalıyorum, buna en uygun yol da makrolardan geçiyor..

Buyrun , istediğiniz üzere düzenledim ve sarı ile renklendirdim düzenlediğim noktayı.

Çok teşekkürler, fakat bu işlemi üstte belirttiğim nedenlerden dolayı makro ile yapmam gerekiyor.

 

[Ömer]

Bu şekilde deneyin.

Sub OzetAl()
 
    Dim s(), a1, deg, say As Long, i As Long, d As Object, j As Byte
 
    Set d = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    Sheets("Sayfa2").Select
    Cells.Clear
    
    With Sheets("Sayfa1")
        For i = 1 To .Cells(Rows.Count, "G").End(xlUp).Row
            deg = .Cells(i, "G")
            If Not d.exists(deg) Then
                ReDim s(7 To 9)
                For j = 7 To 9
                    s(j) = .Cells(i, j)
                Next j
                d.Add deg, s
            Else
                s = d.Item(deg)
                s(8) = s(8) + .Cells(i, "H")
                s(9) = s(9) + .Cells(i, "I")
                d.Item(deg) = s
            End If
        Next i
    End With
        
    a1 = d.items: say = d.Count
 
    For i = 0 To say - 1
        s = a1(i)
        For j = 7 To 9
            Cells(i + 1, j - 6) = s(j)
        Next j
    Next i
    
    Range("A1:C" & say + 1).Borders.LineStyle = 1
    Range("A" & say + 1) = "Toplam"
    Range("B" & say + 1) = "=Sum(B2:B" & say & ")"
    Range("C" & say + 1) = "=Sum(C2:C" & say & ")"
 
    Set d = Nothing
 
End Sub

 

[By_eyicaN]

Çok teşekkür ederim Allah (c.c.) razı olsun Ömer.

 

[Ömer]

Rica ederim, Allah hepimizden razı olsun.