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.
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
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