Nieuwe ingevoerde waarde bij oude optellen

[MrSpock]

Ik zal waarschijnlijk iets heel simpels over het hoofd zien

Ik heb een invoerblad in excel hier voer ik de hoeveelheid storingen in die een bepaalde machine heeft gehad in de dag daarvoor.
Nu wil ik via een button deze invoer cel leeg maken en dan opnieuw de waarde van de nieuwe dag invullen, dit is niet het probleem.
Ik wil graag de ingevoerde waardes per dag bij elkaar optellen.
Dus maandag heb ik 1 storing (totaal voor die week staat op 1)
Ik maak het invoer veld leeg
Dinsdag heb ik 2 storingen (totaal voor die week staat op 3)
Ik maak het invoerveld leeg
Woensdag heb ik 1 storing (totaal voor die week staat op 4)
Het moet iets simpels zijn wat ik niet zie

 

[jgkdrt]

Dat kan met VBA.
Zet onderstaande code in de module van het betreffende blad.
De code gaat er vanuit dat de invoercel A2 is en het resultaat in B2 komt.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
        Me.Range("B2") = Me.Range("B2") + Target
    End If
End Sub

 

[MrSpock]

Bedankt dit werkt
Maar wat als ik het op meerdere cellen wil toepassen

 

[jgkdrt]

Als het bv de cellen A2:A20 betreft, dan zou je dit kunnen gebruiken:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("A2:A20")) Is Nothing Then
        If Target.Count = 1 Then
            Target.Offset(0, 1) = Target.Offset(0, 1) + Target
        End If
    End If
End Sub

of als het om een aantal specifieke (hier: E2,F8,G16 en H22) cellen gaat, zou je dit kunnen gebruiken:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Union([E2], [F8], [G16], [H22])) Is Nothing Then
        If Target.Count = 1 Then
            Target.Offset(0, 1) = Target.Offset(0, 1) + Target
        End If
    End If
End Sub

 

[JEC.]

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E2, F8, G16, H22")) Is Nothing And Target.Count = 1 Then Target.Offset(, 1) = Target.Offset(, 1) + Target
End Sub

 

[MrSpock]

Ik maak gebruik van de volgende VBA
Maar zodra ik begin aan If Not Intersect(Target, Me.Range("AB2:AB20")) Is Nothing Then krijg ik een runtime erro 28 uit of stack place
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A2:A20")) Is Nothing Then
If Target.Count = 1 Then
Target.Offset(0, 1) = Target.Offset(0, 1) + Target
End If
End If
End Sub

 

[jgkdrt]

Het probleem zit in deze regel:

If Not Intersect(Target, Me.Range("J5:FJ6")) Is Nothing Then

Moet ws worden

If Not Intersect(Target, Me.Range("J5:J36")) Is Nothing Then

Daarnaast staat

If Not Intersect(Target, Me.Range("F5:F36")) Is Nothing Then

er twee keer in, lijkt me niet de bedoeling.

En dan zul je je code het beste kunnen beginnen met

Application.EnableEvents = False
'…
'…
'en eindigen met
Application.EnableEvents = True

 

[MrSpock]

Voor nu oplossing gevonden

Oops typo fout
Bedankt

Zal wat worden als ik hem moet gaan aanpassen voor het jaar 2023 dat wordt goed opletten dan:thumb::d

 

[jgkdrt]

En als je deze code zou gebruiken, dan loop je minder kans op fouten en het werkt denk ik ook:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    For i = 0 To 49
        If Not Intersect(Target, Range("F5:F36").Offset(0, 2 * i)) Is Nothing Then
            If Target.Count = 1 Then
                Target.Offset(0, 1) = Target.Offset(0, 1) + Target
            End If
            Exit For
        End If
    Next
    Application.EnableEvents = True
End Sub

 

[jgkdrt]

Deze is wellicht beter:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Row > 4 And Target.Row <= 36 Then
        If Target.EntireColumn.Range("A3") = "Invoer" Then
            Target.Offset(0, 1) = Target.Offset(0, 1) + Target
        End If
    End If
End Sub

Deze code kijkt of er in de derde rij van de kolom van Target de waarde "Invoer" staat en zo ja, wordt de optelling uitgevoerd in de cel rechts van Target.