Hücreye yazdığım sayıyı otomatik toplasın

[vasifokur]

Herkese iyi akşamlar. yukarıdaki başlıkla ilgili sitede bir formül buldum. Gerçekten harika. otomatik toplama örnekte A1 hücresi ile sınırlı. Aynı toplamayı örneğin A1 ile A20 hücreleri arasında uygulayabilir miyiz ? İlgilenen arkadaşlarıma şimdiden çok teşekkür ederim. Metin Karaaağaç!ın 11.02.2008 tarinhinde göndewrmiş olduğu formül aşağıdadır :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Static dAccumulator As Double
With Target
If .Address(False, False) = "A1" Then
If Not IsEmpty(.Value) And IsNumeric(.Value) Then
dAccumulator = dAccumulator + .Value
Else
dAccumulator = 0
End If
Application.EnableEvents = False
.Value = dAccumulator
Application.EnableEvents = True
End If
End With
End SubNOT: Arkadaşlar, bu tür örnekler

 

[İhsan Tank]

Private Sub CommandButton1_Click()
Range("A23").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-22]C:R[-1]C)"
Range("A22").Select
MsgBox " excel.web.tr ailesine teşekkürler"
End Sub

arkadaşım bir buton oluşturup denermisin

 

[vasifokur]

Private Sub CommandButton1_Click()
Range("A23").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-22]C:R[-1]C)"
Range("A22").Select
MsgBox " excel.web.tr ailesine teşekkürler"
End Sub

arkadaşım bir buton oluşturup denermisin

Sayın Çılgın 86'lı . Öncelikle teşekkür ederim. İstediğim biraz farklı bir şey. Yukarıda belirttiğim formülde A1 hücresine yazdığım rakamlar toplanarak A1 hücresine yazılıyor.Aynı işlemi A2 hücresinde de uygulamak istiyorum. Örneğin A1 hücresine yazdığım rakamlar toplanarak A1 hücresine yazılırken ,A2 hücresine yazdığım rakamlar toplanarak A2 hücresine yazılmalı A3 ..... A20 hücreleri için de aynı işlem tekrarlanmalı.

 

[İhsan Tank]

örnek dosya eklerseniz daha rahat yardımcı olmaya çalışırız. ayrıca uzman arkadaşların dosya hazırlamasını engellemiş olursunuz

 

[vasifokur]

Örnek dosya ektedir. A1 hücresine yazılan rakamlar otomatik olarak toplanıyor.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu ilgili sayfanın kod bölümüne uygulayıp denermisiniz.

Option Explicit
Dim İLK_VERİ As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A1:A20]) Is Nothing Then Exit Sub
    If Target = "" Then
        İLK_VERİ = Empty
        Exit Sub
    End If
    If IsNumeric(Target) Then
        Application.EnableEvents = False
        Target = İLK_VERİ + Target
        Application.EnableEvents = True
    End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    İLK_VERİ = Target
End Sub

 

[vasifokur]

Sn Korhan Bey; ellerinize sağlık,tam istediğim gibi olmuş. Teşekkürler.