Sub Worksheet_Change Ereigniss

[mausgambler]

Hallo !
Ich habe ein Tabellenblatt in dem ich den Bereich G3-N5000 auf Änderungen Überwache.
Der mögliche Wert dieser Zellen ist x oder leer, und die x werden dann in jeder Zeile gezählt.
Nun dachte ich, die beste Möglichkeit auf eine Änderung in einer Zeile zu reagieren ist das Change-Ereignis, da ich dort ja gleich die Zeilennummer übergeben bekomme und nur dort neu Berechnung muß, und nicht immer die ganzen 5000 Zeilen.
In dieser Liste werden dann aber auch schon mal über mehrere Zeilen Werte reinkopiert bzw. mehrere markiert und gelöscht und dann wird das change Ereignis leider nur für die erste Zeile dieser Range ausgeführt und die Anderen werden nicht neu berechnet. Muß ich nun wirklich bei jeder Änderung die ganzen 5000 Zeilen durchlaufen lassen und neu berechnen um das lösen zu können (mehrere Zeilen reinkopieren bzw. mehrere Zeilen löschen) oder wie löst man das am Besten.

Herzlichen Dank für Eure Hilfe

[Steffl]

Hallo,

Muß ich nun wirklich bei jeder Änderung die ganzen 5000 Zeilen durchlaufen lassen und neu berechnen um das lösen zu können (mehrere Zeilen reinkopieren bzw. mehrere Zeilen löschen) oder wie löst man das am Besten.

Nein, könntest Du aber uns dein bisheriges Makro zeigen?

[LCohen]

Gute Idee erst mal!

Einen Tod musst Du leider sterben: Formeln kalkulieren zeitlich länger, halten das Modell jedoch konsistent. 
Ereignisse ermöglichen gewissermaßen ein Calculate in einer Zelle, aber nur in einer (bzw. allen, die durch das Ereignis angesprochen werden).

Ereignisse reagieren nicht auf Einkopiertes.

Ich würde es wie folgt lösen: Ereignis ist klasse. Dazu ein Refresh-Makro, welches das gesamte Modell neu rechnet. Das reicht dann, nachdem Du mit mehreren Kopiervorgängen durch bist.

[mausgambler]

Sicher:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Wochen(3) As Long, i As Long, aZeile As Long, J As Long, Wochenz As Long, Bereich As Range
  ' Legt Bereich fest der auf Change überwacht wird und steigt aus, wenn in einem anderen Bereich was geändert wurde
  Set Bereich = Range("G3", "N5000")
  If Intersect(Target, Bereich) Is Nothing Then
    Exit Sub
  Else '----------------------------------------- Wenn im überprüften Bereich was geändert wurde
    aZeile = Target.Row
    If Cells(aZeile, "G") = "x" Then
      Wochenz = Wochenz + 1
    End If
    If Cells(aZeile, "H") = "x" Then
      Wochenz = Wochenz + 1
    Else
      If Wochenz > 0 Then
        Wochen(J) = Wochenz
        J = J + 1
        Wochenz = 0
      End If
    End If
    If Cells(aZeile, "I") = "x" Then
      Wochenz = Wochenz + 1
    Else
      If Wochenz > 0 Then
        Wochen(J) = Wochenz
        J = J + 1
        Wochenz = 0
      End If
    End If
usw.....................

Ich habe auch andere Projekte, wo ich das gleiche Problem mit dem Reinkopieren und dem Löschen habe, deshalb suche ich grundsätzlich eine Lösung für das Problem in VBA.
Sollte also in VBA gelöst werden, nicht mit Formeln.

Ein eigenes Makro schreiben, daß mit Hand eben nur dann gestartet wird, wenn mehrere Zeilen reinkopiert oder gelöscht werden, wäre natürlich eine Möglichkeit.
Da aber nicht nur ich sondern auch Andere mit der Liste arbeiten keine optimale Lösung.
Ideal wäre, wenn sich mehrere Zeilen ändern (durch kopieren oder löschen), dass dann dieses Makro (alle Zeilen neu Berechnen) automatisch aufgerufen wird oder so und bei Änderungen in nur einer Zeile eben der Code in der Change-Funktion, das wäre vielleicht eine Möglichkeit aber wie kann ich das erkennen um darauf zu reagieren ?

[Flotter Feger]

Hallöchen,

Deine Annahme ist definitiv falsch ...

In dieser Liste werden dann aber auch schon mal über mehrere Zeilen Werte reinkopiert bzw. mehrere markiert und gelöscht und dann wird das change Ereignis leider nur für die erste Zeile dieser Range ausgeführt und die Anderen werden nicht neu berechnet.

Siehe hier ... werden über Strg+V Daten eingefügt, wird dir genau die Anzahl der geänderten Zellen angezeigt ...

PHP-Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:D5")) Is Nothing Then
    MsgBox Target.Cells.Count & " Zellen geändert !!!"
End If
End Sub 


Die kannst du dann natürlich über eine For...Each-Schleife abklappern.

[Steffl]

Hallo,

wie Sabina es bereits vorgeschlagen hat, durchläuft mein Vorschlag das mit For Each

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Wochen(3) As Long, i As Long, aZeile As Long, J As Long, Wochenz As Long, Bereich As Range
  Dim rngAreas As Range, rngZelle As Range
  
  ' Legt Bereich fest der auf Change überwacht wird und steigt aus, wenn in einem anderen Bereich was geändert wurde
  Set Bereich = Range("G3", "N5000")
  If Intersect(Target, Bereich) Is Nothing Then
    Exit Sub
  Else '----------------------------------------- Wenn im überprüften Bereich was geändert wurde
    For Each rngAreas In Target.Areas
      For Each rngZelle In rngAreas.Cells
        aZeile = rngZelle.Row
        If Cells(aZeile, "G") = "x" Then
          Wochenz = Wochenz + 1
        End If
        If Cells(aZeile, "H") = "x" Then
          Wochenz = Wochenz + 1
        Else
          If Wochenz > 0 Then
            Wochen(J) = Wochenz
            J = J + 1
            Wochenz = 0
          End If
        End If
        If Cells(aZeile, "I") = "x" Then
          Wochenz = Wochenz + 1
        Else
          If Wochenz > 0 Then
            Wochen(J) = Wochenz
            J = J + 1
            Wochenz = 0
          End If
        End If
      Next rngZelle
    Next rngAreas
'usw.....................

[mausgambler]

Hallo !
Das funktioniert schon richtig, aber sobald er z.b. eine zweite Zeile zu bearbeiten hat(z.b. wenn 2 Zeilen gelöscht wurden oder reinkopiert) und er sich im next rngZelle ist, durchläuft er das ganze zig. mal, bevor er ein Ergebnis in der 2 Zeile gibt.
z.b. durchläuft er bei 1 Zeile das ganze nur einmal, bei 2 Zeilen zig mal mit aZeile (aktuelle Zeile)=3, obwohl dies die erste Zeile ist, die er bereits fertig berechnet hat.


Denke ich habe da eventuell deinen Code nicht richtig eingefügt, kannst bitte nochmal drüberschauen.
------------------------------------------------------------------------------------------------------------------------------------------

 

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Wochen(3) As Long, i As Long, aZeile As Long, J As Long, Wochenz As Long, Bereich As Range, rngAreas As Range, rngZelle As Range
  ' Legt Bereich fest der auf Change überwacht wird und steigt aus, wenn in einem anderen Bereich was geändert wurde
  Set Bereich = Range("G3", "N5000")
  If Intersect(Target, Bereich) Is Nothing Then
    Exit Sub
  Else '----------------------------------------- Wenn im überprüften Bereich was geändert wurde
    For Each rngAreas In Target.Areas
      For Each rngZelle In rngAreas.Cells
         aZeile = rngZelle.Row
         If Cells(aZeile, "G") = "x" Then
           Wochenz = Wochenz + 1
         End If
         If Cells(aZeile, "H") = "x" Then
           Wochenz = Wochenz + 1
         Else
           If Wochenz > 0 Then
             Wochen(J) = Wochenz
             J = J + 1
             Wochenz = 0
           End If
         End If
         If Cells(aZeile, "I") = "x" Then
           Wochenz = Wochenz + 1
         Else
           If Wochenz > 0 Then
             Wochen(J) = Wochenz
             J = J + 1
             Wochenz = 0
           End If
         End If
         If Cells(aZeile, "J") = "x" Then
           Wochenz = Wochenz + 1
         Else
           If Wochenz > 0 Then
             Wochen(J) = Wochenz
             J = J + 1
             Wochenz = 0
           End If
         End If
         If Cells(aZeile, "K") = "x" Then
           Wochenz = Wochenz + 1
         Else
           If Wochenz > 0 Then
             Wochen(J) = Wochenz
             J = J + 1
             Wochenz = 0
           End If
         End If
         If Cells(aZeile, "L") = "x" Then
           Wochenz = Wochenz + 1
         Else
           If Wochenz > 0 Then
             Wochen(J) = Wochenz
             J = J + 1
             Wochenz = 0
           End If
         End If
         If Cells(aZeile, "M") = "x" Then
           Wochenz = Wochenz + 1
         Else
           If Wochenz > 0 Then
             Wochen(J) = Wochenz
             J = J + 1
             Wochenz = 0
           End If
         End If
         If Cells(aZeile, "N") = "x" Then
           Wochenz = Wochenz + 1
           Wochen(J) = Wochenz
         Else
           If Wochenz > 0 Then
             Wochen(J) = Wochenz
             J = J + 1
             Wochenz = 0
           End If
         End If
         If Wochen(0) > 0 Then Range("R" & aZeile).Value = Wochen(0) Else Range("R" & aZeile).Value = ""
         If Wochen(1) > 0 Then Range("T" & aZeile).Value = Wochen(1) Else Range("T" & aZeile).Value = ""
         If Wochen(2) > 0 Then Range("V" & aZeile).Value = Wochen(2) Else Range("V" & aZeile).Value = ""
         If Wochen(3) > 0 Then Range("X" & aZeile).Value = Wochen(3) Else Range("X" & aZeile).Value = ""

         J = 0
         Wochenz = 0
         For J = 0 To 3
           Wochen(J) = 0
         Next
         J = 0
    Next rngZelle
   Next rngAreas
  End If
End Sub

------------------------------------------------------------------------------------------------------------------------------------------------------

[Flotter Feger]

Hallo,

1. ... von ganzen Zeilen einfügen, oder löschen, war bisher nie die Rede ...
2. ... beim Einfügen, musst du eben die Target.Column auf >"N" prüfen und dann eventuell die For...Each-Schleife mit Exit For verlassen.

3. ... beim Löschen von ganzen Zeilen hast du ein Problem ... Excel rückt dann die Zeilen von irgendwo her nach und das sind dann die Target-Werte ... Ob das so gewollt ist ...

[00202]

Hallo,

wenn bei "Worksheet_Change" in der Tabelle etwas geschrieben oder gelöscht wird, musst Du die "Events" abschalten - sonst kommt eben "zigmal", denn das ruft das "Worksheet_Change" immer wieder auf.

Die müssen aber zum Schluss wieder eingeschaltet werden, deshalb sollte man Programmierungen mit "Exit Sub" im Code vermeiden. Schreibe es z. B. so:

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    ' Deklarationsteil
    '
    '
    On Error GoTo Fin
    Application.EnableEvents = False
    ' Code
    '
    '
Fin:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

Wenn Du jetzt noch ein "Exit Sub" im Code hast, bleiben die Events ausgeschaltet.

Du kannst natürlich auch noch andere Störfaktoren ausschalten - je nach Bedarf.

Das ist jetzt nur auf das "zigmal" bezogen - die Funktionalität des Codes habe ich mir nicht angeschaut.

[mausgambler]

Herzlichen Dank für Eure Hilfe !!!!
Arbeitet jetzt in annehmbarer Geschwindigkeit.