makro ile kümülatif toplam

[puslukurt]

Merhaba arkadaşlar

excelde herhangi bir hücrede veya benim kullandığım ve formülü yazacağım G4 hücresine öyle bir formül yazalım ki kümülatif toplasın şöyle ki;
G4 hücresinde 120 rakamı olsun. ben bu 120 rakamının üzerine 43 yazayım otomatik toplayıp G4 hücresine 163 yazsın daha sonra 163 üzerine 14 yazayım otomatik toplayıp 177 yazsın. hücreye böyle formül yazabilir miyiz yazsak formül silinir veya makro ile yazılabileceğini düşünüyorum. Teşekkürler

 

[Ömer]

Merhaba,

Sayfanın kod bölümüne kopyalayınız.

Public d

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [G4]) Is Nothing Then Exit Sub
    
    On Error GoTo 10
    Application.EnableEvents = False
    
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sayı Girin.", vbCritical
            .Value = d
        ElseIf .Value = "" Then
            .Value = ""
            d = 0
        Else
            .Value = .Value + d
        End If
    End With
10 Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    d = [G4]
End Sub

 

[puslukurt]

Merhaba,

Sayfanın kod bölümüne kopyalayınız.

Public d

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [G4]) Is Nothing Then Exit Sub
   
    On Error GoTo 10
    Application.EnableEvents = False
   
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sayı Girin.", vbCritical
            .Value = d
        ElseIf .Value = "" Then
            .Value = ""
            d = 0
        Else
            .Value = .Value + d
        End If
    End With
10 Application.EnableEvents = True
   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    d = [G4]
End Sub

Ömer bey teşekkür ederim. harikasınız.

 

[puslukurt]

Merhaba,

Sayfanın kod bölümüne kopyalayınız.

Public d

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [G4]) Is Nothing Then Exit Sub
   
    On Error GoTo 10
    Application.EnableEvents = False
   
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sayı Girin.", vbCritical
            .Value = d
        ElseIf .Value = "" Then
            .Value = ""
            d = 0
        Else
            .Value = .Value + d
        End If
    End With
10 Application.EnableEvents = True
   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    d = [G4]
End Sub

Ömer bey ufak bir ekleme yapabilir miyiz mümkünse.
g4 hücresi dahil g32 hücresine kadar bu förmülü nasıl yazabiliriz ben d = [G4:G32] olarak denedim olmadı.

 

[Ömer]

Deneyiniz.

Public d

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [G4:G32]) Is Nothing Then Exit Sub
    
    On Error GoTo 10
    Application.EnableEvents = False
    
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sayı Girin.", vbCritical
            .Value = d
        ElseIf .Value = "" Then
            .Value = ""
            d = 0
        Else
            .Value = .Value + d
        End If
    End With
10 Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    d = Target
End Sub

 

[puslukurt]

Deneyiniz.

Public d

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [G4:G32]) Is Nothing Then Exit Sub
    
    On Error GoTo 10
    Application.EnableEvents = False
    
    With Target
        If IsNumeric(.Value) = False Then
            MsgBox "Sayı Girin.", vbCritical
            .Value = d
        ElseIf .Value = "" Then
            .Value = ""
            d = 0
        Else
            .Value = .Value + d
        End If
    End With
10 Application.EnableEvents = True
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    d = Target
End Sub

Ömer Hocam çok teşekkür ederim harikasınız. emeğinize bilginize sağlık