son dolu hücreden yukarı doğru toplam

[oborono]

Merhabalar, bir sütunda alt alta girilen verilerin son dolu hücreden yukarı yedi hücreyi (veriyi) nasıl toplarım.

 

[RBozkurt]

Merhaba, kendinize göre uyarlayınız.
A sütununda arar; B2'ye yazar..

Sub SonDoluHücredenToplam()
    Dim sonDoluHücre As Range
    Dim toplam As Double
    
    'Son dolu hücreyi bul
    Set sonDoluHücre = Range("A" & Rows.Count).End(xlUp)
    
    '7 hücrenin toplamını hesapla
    toplam = Application.WorksheetFunction.Sum(sonDoluHücre.Offset(-6, 0).Resize(7, 1))
    
    'B2 hücresine toplamı yaz
    Range("B2").Value = toplam
End Sub

 

[oborono]

Teşekkür ederim. Bunu A5'den aşağıya veri girdikçe otomatik kendi hesaplasın yapabilir miyiz? Bunun gibi çok sütun olacak.

 

[RBozkurt]

Sayfa kaynak koduna ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim son_dolu_satir As Long
    Dim toplam As Double
    Dim sayac As Integer
    
    ' Değişiklik yapılan hücre A sütununda değilse çık
    If Target.Column <> 1 Then Exit Sub
    
    ' A5'ten başlayarak en son dolu satırı bul
    son_dolu_satir = Cells(Rows.Count, "A").End(xlUp).Row
    If son_dolu_satir < 5 Then Exit Sub ' A4'ten önce yeterli sayıda satır yoksa çık
    
    ' A1 ile A4 arasındaki hücreleri toplama işlemine dahil etme
    If Target.Row <= 4 Then Exit Sub
    
    ' Son 7 satırın toplamını hesapla
    If son_dolu_satir >= 5 And son_dolu_satir <= 11 Then
        ' Satır sayısı 7'den az ise tüm satırların toplamını al
        For sayac = 5 To son_dolu_satir
            toplam = toplam + Cells(sayac, "A").Value
        Next sayac
    Else
        ' Geriye doğru son 7 satırın toplamını al
        For sayac = 0 To 6
            toplam = toplam + Cells(son_dolu_satir - sayac, "A").Value
        Next sayac
    End If
    
    ' Toplamı B2 hücresine yaz
    Range("B2").Value = toplam
End Sub

 

[oborono]

Çok Teşekkür ederim, açıklamalı, elinize sağlık.

 

[RBozkurt]

Rica ederim iyi çalışmalar.