Alt Toplam Al - Microsoft Excel

Makro aracılığıyla alt toplam alma işlemi ile ilgili bir örnektir.

Konu ile ilgili örnek bir veri setine aşağıdaki bağlantıdan ulaşabilirsiniz.

malzeme sayıları veri seti

Option Explicit

Sub AltToplamAl()
    Range("A1:B13").Subtotal _
                    GroupBy:=1, _
                    Function:=xlSum, _
                    TotalList:=Array(2), _
                    Replace:=True, _
                    PageBreaks:=False, _
                    SummaryBelowData:=True
End Sub

Sub AltToplamTemizle()
    Dim i As Integer
    
    Selection.ClearOutline
    
    For i = [A1048576].End(xlUp).Row To 1 Step -1
        If Cells(i, 1).Font.Bold = True Then
            Range(i & ":" & i).Delete Shift:=xlUp
        End If
    Next
End Sub

Option Explicit

Sub AltToplamAl()
    Range("A1:B13").Subtotal _
                    GroupBy:=1, _
                    Function:=xlSum, _
                    TotalList:=Array(2), _
                    Replace:=True, _
                    PageBreaks:=False, _
                    SummaryBelowData:=True
End Sub

Sub AltToplamTemizle()
    Dim i As Integer
    
    '--------------------------------------------------
    'Alt toplam alındığında sol kısımda oluşan
    'alt toplam çizgilerini temizliyor.
    '--------------------------------------------------
    Selection.ClearOutline
    
    '--------------------------------------------------
    'Çalışma mantığı şu:
    '
    'Bizim verilerimizin hiçbirinin yazı biçimi kalın
    'yani bold değil. Alt toplam verileri de hep bold
    'olarak biçimlendiriliyor. Eğer ben bu bold yazıları
    'tespit edersem ve bu satırı silersem alt toplam
    'verilerini de silmiş olurum.
    '
    'Döngüyü ters çalıştırmamızın sebebi de şu:
    'Satır silindiği zaman diğer satırların yerleri
    'değiştiği için doğal olarak satır sayıları da
    'değişiyor. Bu da karışıklığa sebep oluyor.
    'Tersten başlattığımızda satır silsek bile
    'üstte kalan satırlar bundan etkilenmediği
    'için sıkıntı olmuyor.
    '--------------------------------------------------
    For i = [A1048576].End(xlUp).Row To 1 Step -1
    
        '--------------------------------------------------
        'Eğer ilgili hücrenin yazı biçimi Bold ise işlem yap.
        '--------------------------------------------------
        If Cells(i, 1).Font.Bold = True Then
            
            '--------------------------------------------------
            'Satırı aşağıdaki satırlar yukarı
            'sürüklenecek şekilde sil.
            '--------------------------------------------------
            Range(i & ":" & i).Delete Shift:=xlUp
        End If
    Next
End Sub