Aynı Hücrede Sürekli Toplama Yapma

[Oxygenc]

İki hücremiz A1 ve B1 olsun

Yapmak istediğim şey B1 e bir değer girildiğinde A1'de ki eski değerle toplanması.
Yani;

1. Adım

A1:0
B1:5 ---> A1:5

2. Adım

A1:5
B1:10 ---> A1:15

Normal toplama işleminde A1'in değeri B1 e göre hesaplanıyor ancak benim yapmak istediğim işlemde ise 1. Adım tamamlandıktan sonra B1 hücresindeki sayı silinse yada değiştirilse de 2. Adıma geçildiğinde A1 hücresinde ki değer 1. adımda ki toplamı versin.

Yani her adımda bir önceki toplam kalsın.

teşekkür ederim

 

[sirkülasyon]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
[A1] = [A1] + [B1]
End Sub

Korhan AYHAN uzmanıma aittir

 

[Oxygenc]

İşin VB kısmını bilmiyorum bu dediğiniz kodu sitede bulmuştum ancak böyle bir hata alıyorum sürekli o yüzden başlık açtım

 

[sirkülasyon]

sayfada iken alt+F11 kombinasyonu ile açılan yere yukarıda yer alan KORHAN AYHAN uzmanıma ait kodu yapıştıınız.
İkinci olarak modülü siliniz

 

[sirkülasyon]

Örnek Dosya

 

[Oxygenc]

Örnek Dosya

Hocam yardım için teşekkürler, muhtemeln son bir soru;

Aynı işlemi A2 ve B2 için de yapmak istersek kodlardaki değişiklikler nasıl olmalı?

Ben buy şekilde A26 ve B26 ya kadar gideceğim

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

B1:B26 arasında çalışır. Kendinize göre düzeltebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B1:B26")) Is Nothing Then Exit Sub
    Target.Offset(0, -1) = Target.Offset(0, -1) + Target
End Sub

 

[Oxygenc]

Çok teşekkürler Korhan Bey,
Tam istediğim gibi oldu ancak, birden fazla hücreyi silmek istediğimde şu hatayı alıyorum

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range
    On Error GoTo Son
    If Intersect(Target, Range("B1:B26")) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        Target.Offset(0, -1) = Target.Offset(0, -1) + Target
    Else
        For Each Veri In Selection
            If Veri.Value <> "" And Veri.Column = 2 Then
                Veri.Offset(0, -1) = Veri.Offset(0, -1) + Veri.Value
            End If
        Next
    End If
Son:
End Sub

 

[Oxygenc]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range
    On Error GoTo Son
    If Intersect(Target, Range("B1:B26")) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        Target.Offset(0, -1) = Target.Offset(0, -1) + Target
    Else
        For Each Veri In Selection
            If Veri.Value <> "" And Veri.Column = 2 Then
                Veri.Offset(0, -1) = Veri.Offset(0, -1) + Veri.Value
            End If
        Next
    End If
Son:
End Sub

Şimdi oldu, tekrar çok teşekkür ederim

 

[hyr001]

Merhabalar, benim de benzer bir tablom var. Ancak ben aynı işlemi (yani b ye yazıp sürekli a da toplama işlemini) aynı sayfa içinde d'ye yazıp c'de de toplamak istiyorum. Yani hem a ve b sütunları hem de c ve d sütunları için yapmak istediğimde kodu nasıl değiştirmem gerekiyor ?

Şimdiden teşekkür ederim.