Excel VBA Seçilen Satıra Kadar Kümülatif Toplam Al


A sütununda seçilen satıra kadar olan sayıların kümülatif toplamını alan ve seçili hücrenin yanına (B sütununa) yazan bir koddur.

Kod
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static EskiHucre As Range
    On Error Resume Next
    
    If Intersect(Target, [A:A]) Is Nothing Or Target.Count > 1 Then Exit Sub
    
    Dim kumulatifToplam As Long
    kumulatifToplam = WorksheetFunction.Sum(Range("A1:" & Target.Address))
    
    If Target.Offset(0, 1).Value = "" Then
        Target.Offset(0, 1).Value = kumulatifToplam
        EskiHucre.Value = ""
        Set EskiHucre = Target.Offset(0, 1)
    Else
        EskiHucre.Interior.ColorIndex = xlColor1
    End If
End Sub
Kod (Açıklamalı)
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '--------------------------------------------------
    'Seçim değiştiğinde bir önceki hücreyi eski
    'haline getirebilmek için onun bilgisini
    'saklamak gerekiyor. Bu değişkeni bunun
    'için kullanacağız.
    '--------------------------------------------------
    Static EskiHucre As Range
    
    '--------------------------------------------------
    'Bir hata olursa sonraki satırdan devam et.
    '--------------------------------------------------
    On Error Resume Next
    
    '--------------------------------------------------
    'Eğer yapılan seçim A sütunu dışındaysa veya
    'seçilen alandaki toplam hücre sayısı 1'den
    'büyükse kod çalışmasın, yordamdan çık.
    '--------------------------------------------------
    If Intersect(Target, [A:A]) Is Nothing Or Target.Count > 1 Then Exit Sub
    
    '--------------------------------------------------
    'Kümülatif toplamı saklayacağımız
    'değişkeni tanımladık.
    '--------------------------------------------------
    Dim kumulatifToplam As Long
    
    '--------------------------------------------------
    'A sütununda seçilen satıra kadar olan alan için
    'kümülatif toplamı hesaplıyoruz.
    '--------------------------------------------------
    kumulatifToplam = WorksheetFunction.Sum(Range("A1:" & Target.Address))
    
    '--------------------------------------------------
    'Eğer seçili hücrenin bir sağındaki hücre
    'boşsa içindeki kodlar çalışsın.
    '--------------------------------------------------
    If Target.Offset(0, 1).Value = "" Then
        
        '--------------------------------------------------
        'Kümülatif toplamı B sütununda
        'ilgili yere yazdır.
        '--------------------------------------------------
        Target.Offset(0, 1).Value = kumulatifToplam
        
        '--------------------------------------------------
        'Bir önceki hücre değeri artık bizim için
        'kullanılmayacağından dolayı bu hücredeki
        'değeri temizliyoruz.
        '--------------------------------------------------
        EskiHucre.Value = ""
        
        '--------------------------------------------------
        'Mevcut hücre bilgilerini de yeni bir atama yaparak
        'saklıyoruz. Mevcut hücre de eski hücre olduğu zaman
        'bu bilgi işimize yarayacak.
        '--------------------------------------------------
        Set EskiHucre = Target.Offset(0, 1)
    Else
        
        '--------------------------------------------------
        'Eğer şart sağlanmadıysa hücre rengini değiştir.
        '--------------------------------------------------
        EskiHucre.Interior.ColorIndex = xlColor1
    End If
End Sub

Bunlar da hoşunuza gidebilir...


Bir cevap yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir