Sayfa isimlerine göre Toplam

[MrExcelMr]

Merhaba,

Ekteki dosyada farklı sayfalardaki malzemelerin cinsine göre toplamlarını Sonuç sayfasına hesaplama yapmak istiyoruz.

https://s5.dosya.tc/server4/3rdd66/Kitap1.xlsx.html

 

[Korhan Ayhan]

B3 hücresine uygulayıp deneyiniz.

Diğer hücrelere kopyala-yapıştır ile uygulayınız.

=ETOPLA(DOLAYLI(A$1&"!A:A");$A3;DOLAYLI(A$1&"!B:B"))

 

[MrExcelMr]

KOrhan Bey,
ilginiz için teşekkür ederim.

 

[MrExcelMr]

B3 hücresine uygulayıp deneyiniz.

Diğer hücrelere kopyala-yapıştır ile uygulayınız.

=ETOPLA(DOLAYLI(A$1&"!A:A");$A3;DOLAYLI(A$1&"!B:B"))

KOrhan Bey bu işlem makro ile yapılabilir mi. Destek olur musunuz.

 

[Korhan Ayhan]

Makro kaydet yöntemiyle formülü makroya çevirebilirsiniz.

 

[Ziynettin]

Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Application.ScreenUpdating = False
    Set s2 = Sheets("SONUÇ")
    s2.Activate
    s2.Cells.ClearContents
    s2.Cells.ClearFormats
    ActiveWindow.DisplayGridlines = False
    Set dc = CreateObject("scripting.dictionary")
    sut = 1
    For j = 1 To Worksheets.Count
        Set s1 = Sheets(j)
        If s1.Name <> "SONUÇ" Then
            son = s1.Cells(Rows.Count, 1).End(3).Row
            If son > 1 Then
                a = s1.Range("A1:B" & son).Value
                ReDim b(1 To UBound(a), 1 To 2)
                For i = 2 To UBound(a)
                    dc(a(i, 1)) = dc(a(i, 1)) + a(i, 2)
                Next i
                s2.Cells(1, sut).Resize(, 2).Merge
                s2.Cells(1, sut) = s1.Name
                s2.Cells(2, sut) = "Cinsi"
                s2.Cells(2, sut + 1) = "Tutar"
                s2.Cells(3, sut).Resize(dc.Count, 2) = Application.Transpose(Array(dc.keys, dc.items))
                s2.Cells(1, sut).Resize(dc.Count + 2, 2).Borders.Color = rgbSilver
                sut = sut + 1 * 2
                dc.RemoveAll
            End If
        End If
    Next j
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation
End Sub

 

[MrExcelMr]

Ziynettin Bey çok teşekkür ederiz.