Tablodaki son satırın altına toplam almak

[sezgin_ustun]

Merhaba,

C sütunun son satırının bir altına aşağıdaki hesaplamayı yapabilir miyiz?
Toplam 100 (C sütunu toplamı)
Kdv 18
Genel Toplam 118

c sutunun son satırı her fatura değişmektedir.

 

[Muzaffer Ali]

Aşağıdaki kodları deneyin.
"BaslangicSatirNo" yu toplama yapılacak ilk satır numarası ile değiştirin.
Aşağıdaki kodlar 3. satırdan itibaren toplama yapar.

Sub Topla()

    Dim BaslangicSatirNo As Double
    Dim SatirSay As Long
    SatirSay = Cells(Rows.Count, "C").End(3).Row
    
    [COLOR="Red"]BaslangicSatirNo = 3[/COLOR]
    
    Cells(SatirSay + 1, "C") = WorksheetFunction.Sum(Range("C" & BaslangicSatirNo & ":C" & SatirSay))
    Cells(SatirSay + 2, "C").Value = Cells(SatirSay + 1, "C").Value * 0.18
    Cells(SatirSay + 3, "C").Value = Cells(SatirSay + 1, "C").Value + Cells(SatirSay + 2, "C").Value
    Cells(SatirSay + 1, "B").Value = "Toplam"
    Cells(SatirSay + 2, "B").Value = "KDV"
    Cells(SatirSay + 3, "B").Value = "Genel Toplam"
End Sub

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırırsanız, C sütunu her değiştiğinde, değişen satırın altına o satıra kadar olan toplamı yazar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
Application.EnableEvents = False

Target.Offset(1, 0) = WorksheetFunction.Sum(Range("C1:C" & Target.Row))
Application.EnableEvents = True

End Sub

Ancak bu durumda aradaki bir hücreyi değiştirdiğinizde kodlar çalışmaz. C sütunundaki herhangi bir hücre değiştiğinde mevcut verilerin en altına toplam alması için aşağıdaki kodları kullanabilirsiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
Application.EnableEvents = False

Target.Offset(1, 0) = WorksheetFunction.Sum(Range("C1:C" & Target.Row))
Application.EnableEvents = True

End Sub

Bu kodlar ise hep yeni bir satıra toplama yaptığı için önceki toplam satırını da toplar. Aradaki bir hücreyi değiştirerek sonucu görebilirsiniz.

Gerçekten toplam alınması gereken yerde toplam alan ve değişiklik yapmaya da uygun olan kod ise aşağıdaki şekildedir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
eski = Cells(Rows.Count, "C").End(3).Row
Cells(eski, "D").FormulaR1C1 = "=ISFORMULA(RC[-1])"
If Cells(eski, "D") = True Then
    Cells(eski, "D") = ""
    Exit Sub
Else
yeni = Cells(Rows.Count, "C").End(3).Row + 1
Application.EnableEvents = False
Cells(eski, "D") = ""
Cells(yeni, "C").FormulaR1C1 = "=SUM(R[-" & yeni - 1 & "]C:R[-1]C)"
Application.EnableEvents = True
End If
End Sub

Yalnız bu kod son satırın D hücresini geçici olarak kullanır. Son satırın D hücresine EFORMÜLSE formülünü yazıp, C hücresinin formül olup olmadığını kontrol eder. Formül varsa değişiklik yapmaz, formül yoska bir alt satıra toplam yazar ve geçici olarak kullandığı D sütununu boşaltır.

Muhtemelen bu kod 2013'ten önceki versiyonlarda çalışmaz. EFORMÜLSE formülü önceki versiyonlarda yoktu bildiğim kadarıyla.

 

[YUSUF44]

Sayın dalgalıkur'un kodlarından da yararlanarak son hali şöyle oldu:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub

eski = Cells(Rows.Count, "C").End(3).Row
Cells(eski - 2, "D").FormulaR1C1 = "=ISFORMULA(RC[-1])"
If Cells(eski - 2, "D") = True Then
    Cells(eski - 2, "D") = ""
    Exit Sub
Else

yeni = Cells(Rows.Count, "C").End(3).Row - 2
Application.EnableEvents = False
Cells(eski - 2, "D") = ""
    Cells(yeni + 1, "C").FormulaR1C1 = "=SUM(R[-" & yeni & "]C:R[-1]C)"
    Cells(yeni + 2, "C").FormulaR1C1 = "=round(R[-1]C * 0.18,2)"
    Cells(yeni + 3, "C").FormulaR1C1 = "=R[-2]C+R[-1]C"
    Cells(yeni + 1, "B").Value = "Toplam"
    Cells(yeni + 2, "B").Value = "KDV"
    Cells(yeni + 3, "B").Value = "Genel Toplam"
    Target.Offset(0, -1) = ""
Application.EnableEvents = True
End If
End Sub

Bu kodlar da son kod gibi çalışır. Ancak son iki satırda yani KDV ve Genel Toplam satırlarında çalışmaz. Çünkü öncelikle toplam satırının kullanılması gerekmektedir.

 

[sezgin_ustun]

Sayın Yusuf44 ve Sayın Dalgalıkur

geç dönüş için kusura bakmayın yardımlarınız için teşekkür ederim.