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