Zelle auf Null setzen und weiter addieren

[genossealex]

Hallo zusammen,

ich bräuchte mal eure Hilfe.

Und zwar möchte ich einen Befehl für z. B. die Zelle B3 das alle Zahlen ab Zeile 7 addiert werden, aber wenn 3mal DIREKT nacheinander die Null kommt die B3 auch auf Null gesetzt wird, dann soll von 0 aus weiter addiert werden.

Aktuell hab ich es so das bei 3mal 0 auf gesetzt, aber da fehlt noch das die Nullen direkt hintereinander sein müssen.
Und es funktioniert noch nicht das er dann weiter rechnet.

Wenn es nicht anders geht kann es auch über VBA laufen.


Anbei ist auch ein Beispiel wie es aussehen soll, damit man mich richtig versteht.

Danke schon mal.

[WillWissen]

Hi,

lade mal bitte deine Kniffeldatei hoch. Mit Bildern kann und will niemand etwas anfangen.

[genossealex]

Hi,

lade mal bitte deine Kniffeldatei hoch. Mit Bildern kann und will niemand etwas anfangen.

getan
und das ist 10.000 ;)

Gruß Alex

[Käpt'n Blaubär]

Hallo,

... tja, tja, ... die Genossen eben  :05:

[genossealex]

*PUSH*

[Kuwer]

Hallo,

vielleicht so:

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim vntResult As Variant

 If Not Intersect(Target, Range("$B$7:$G$46")) Is Nothing Then

   On Error Resume Next

   Application.EnableEvents = False

   vntResult = Evaluate(Target.Value)

   If Not IsError(vntResult) Then

     Target.Value = vntResult

   Else

     Target.Value = ""

   End If

   If Target.Row > 8 Then

     With Target.Offset(-2).Resize(3)

       If Application.WorksheetFunction.Count(.Value) Then

         If Application.Sum(.Value) = 0 Then

           Cells(3, Target.Column).Formula = "=SUM(B46:" & Target.Address(0, 0) & ")"

         End If

       End If

     End With

   End If

   Application.EnableEvents = True

   On Error GoTo 0

 End If

End Sub

Du musst nur die Formeln bei Spielstart wieder setzen.

Gruß Uwe

[genossealex]

Hallo,

vielleicht so:

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim vntResult As Variant

 If Not Intersect(Target, Range("$B$7:$G$46")) Is Nothing Then

   On Error Resume Next

   Application.EnableEvents = False

   vntResult = Evaluate(Target.Value)

   If Not IsError(vntResult) Then

     Target.Value = vntResult

   Else

     Target.Value = ""

   End If

   If Target.Row > 8 Then

     With Target.Offset(-2).Resize(3)

       If Application.WorksheetFunction.Count(.Value) Then

         If Application.Sum(.Value) = 0 Then

           Cells(3, Target.Column).Formula = "=SUM(B46:" & Target.Address(0, 0) & ")"

         End If

       End If

     End With

   End If

   Application.EnableEvents = True

   On Error GoTo 0

 End If

End Sub

Du musst nur die Formeln bei Spielstart wieder setzen.

Gruß Uwe

Hallo,

vielen Dank für deine Mühe, aber irgendwas stimmt da noch nicht.
Hast du meinen letzten Code mit eingebunden? Der sollte dafür da sein das ich in den Zellen B7:G46 nicht immer ein = setzen muss im z.B. zu addieren.

[genossealex]

Moin Uwe,

ich danke dir für deine Mühe.
Ich habe es grade mal getestet und in der ersten Spalte funktioniert es.
In den anderen Spalten ist es so, dass wenn er da einmal wieder auf 0 gesetzt hat, er anfangt beim weiter addieren Zahlen aus den anderen Spalten mit einzubeziehen.

[Kuwer]

Hallo,

ja, das konnte so nicht klappen. Mein Fehler.
Teste mal damit:

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim vntResult As Variant

  If Not Intersect(Target, Range("$B$7:$G$46")) Is Nothing Then

    On Error Resume Next

    Application.EnableEvents = False

    vntResult = Evaluate(Target.Value)

    If Not IsError(vntResult) Then

      Target.Value = vntResult

    Else

      Target.Value = ""

    End If

    

    'Formel anpassen bei 3 Nullen

    If Target.Row > 8 Then

      With Target.Offset(-2).Resize(3)

        If Application.WorksheetFunction.Count(.Value) Then

          If Application.Sum(.Value) = 0 Then

            Cells(3, Target.Column).Formula = "=SUM(" & Target.Address(0, 0) & ":" & Cells(46, Target.Column).Address(0, 0) & ")"

          End If

        End If

      End With

    End If

    

    Application.EnableEvents = True

    On Error GoTo 0

  End If

End Sub

Gruß Uwe

[genossealex]

Hallo Uwe,

also aktuell scheint alles zu funktionieren wie es gedacht war   :19:

Ich werde es am Freitag nochmal im aktiven Gebrauch testen.

Heute bist du mein Tagesheld  :100:

DANKE


Gruß Alex