hücreye yazılan sayının üzerine otomatik toplama

[ayhan7tr]

Sayın Arkadaşlar,

aşagıdaki kodu aynı sayfadaki bir çok hücreye nasıl uyguluyabilirim.
teşekkürler

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 Sub

 

[Ferhat Pazarçevirdi]

Aşağıdaki şekilde A1:B20 aralığındaki her hücrede çalıştırabilirsiniz. Siz, bu aralığı kodlarda kırmızı olarak belirttiğim kısımda değişiklik yaparak revize edebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Static dAccumulator As Double
    
    If Not Intersect(Target, Range("[B][COLOR=red]A1:B20[/COLOR][/B]")) Is Nothing Then
        
        With Target
            
            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 With
    
    End If
End Sub

 

[ayhan7tr]

Çok teşekkür ederim ilginize fakat çalışmıyor kullanmak istediğim yer stok çalışması daha önce girilmiş sayının üzerine toplaması gerekiyor.

 

[ayhan7tr]

İlginize çok teşekkür edrim ama çalışmıyor daha önce hücrenin üzerine yazılmış sayının üstüne toplaması gerekiyor

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Dim dAccumulator As Double
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 
    If Not Intersect(Target, Range("A1:B20")) Is Nothing Then
 
        With Target
 
            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 With
 
    End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
dAccumulator = Target
End Sub

 

[ayhan7tr]

Çok harika oldu çok teşekkür ederim. kusuruma bakmazsanız bunun yanına ikinci veya üçüncü bir hücre dizisi nasıl ekleyebilirim
Teşekkür ederim
Saygılarımla,

 

[Levent Menteşoğlu]

Hücre dizisi eklemek için ilgili satırı aşağıdaki gibi değiştirebilirsiniz. Örneğin burada sadece A1:A10 , C1:C10 ve D1: D10 aralıklarında işlem yapılacaktır.

If Not Intersect(Target, Range("A1:A10,C1:C10,D1:D10")) Is Nothing Then

 

[ayhan7tr]

Harikasınız, İlginiz ve yardım severliginiz için çok teşekkür ederim. Başarılar dilerim.
Sevgi ve Saygılarımla

 

[Levent Menteşoğlu]

Rica ederim. Yardımcı olabildiysem ne mutlu bana.