Mehrfachen Code-Durchlauf verhindern

[Hardilein]

Hallo

Ich habe ein Problem mit mehrmals durchlaufendem Code. Ich hätte es wahrscheinlich nicht gleich gemerkt, wenn ich nicht die Error-Abfrage drin hätte. Er fängt nach dem Löschen der Zeilen wieder oben an. Hat dann ein Target.Count von xxx, bei Abfrage des Target.Count springt er statt mit "Goto Ende" runter nun zu If Not IsEmpty(, also 2 Zeilen übersprungen. Springt dann wieder hoch zu Range("C" & datezeile & ":H" & datezeile) = "". Ich sehe hier nicht mehr durch.
Der soll einmal durchlaufen und alles machen was da steht - dachte ich.

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Wochentage, datezeile, Endzeile
Dim Feld As Range
'Application.ScreenUpdating = False
ActiveSheet.Unprotect
On Error GoTo Ende
MsgBox Target.Row & vbLf & Target.Column & vbLf & Target.Count
If Target.Row <> 2 Or Target.Column <> 5 orTarget.Count <> 1 Then GoTo Ende
datezeile = Application.Match("Datum", Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0)
If datezeile > 9 Then Rows("6:" & datezeile - 4).Delete                                         'Löschen der Zeilen
If Not IsEmpty(Cells(2, 5)) Then
   datezeile = Application.Match("Datum", Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0)
   MsgBox "bin drin"
   Range("C" & datezeile & ":H" & datezeile) = ""
   Range("C" & datezeile & ":H" & datezeile).Borders(xlInsideVertical).LineStyle = xlNone
   Wochentage = Application.Match(CLng(CDate(Mid$(Cells(2, 7), 8))), Worksheets("Tagesdaten").Range("A:A"), 1) _
   - Application.Match(Cells(2, 5), Worksheets("Tagesdaten").Range("A:A"), 0) + 1
   Endzeile = 6 + Wochentage - 1
   Rows("6:" & Endzeile).Insert
   
   Range("A6:A" & Endzeile).NumberFormat = "d/;;;"
   Range("B6:B" & Endzeile & ",G6:G" & Endzeile & ",C6:C" & Endzeile & ",J6:J" & Endzeile).NumberFormat = "General"
   Range("D6:D" & Endzeile & ",E6:E" & Endzeile).NumberFormat = "0.00;;;"
   Range("F6:F" & Endzeile).NumberFormat = "[>10]\*\*0.00;[>0]0.00;;"
   Range("H6:H" & Endzeile & ",I6:I" & Endzeile).NumberFormat = "0.00;0;;@"
   
   Set Feld = Range("A6:J" & Endzeile)
   Feld.Font.Bold = False
   
   With Feld.Borders(xlEdgeLeft)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Feld.Borders(xlEdgeRight)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Feld.Borders(xlEdgeTop)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Feld.Borders(xlEdgeBottom)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Feld.Borders(xlInsideVertical)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Feld.Borders(xlInsideHorizontal)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   Range("A6:A" & Endzeile).FormatConditions.Delete
   Range("A6:A" & Endzeile).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=$A5"
   Range("A6:A" & Endzeile).FormatConditions(1).Font.ColorIndex = 2

   Range("A6:A" & Endzeile).FormulaLocal = "=blabla"
   Range("B6:B" & Endzeile).FormulaR1C1 = "=blabla"
   Range("C6:C" & Endzeile).FormulaLocal = "=blabla"
   Range("D6:D" & Endzeile).FormulaR1C1 = "=blabla"
   Range("E6:E" & Endzeile).FormulaR1C1 = "=blabla"
   Range("F6:F" & Endzeile).FormulaR1C1 = "blabla"
   Range("G6:G" & Endzeile).FormulaR1C1 = "=blabla"
   Range("H6:H" & Endzeile).FormulaR1C1 = "=blabla"
   Range("I6:I" & Endzeile).FormulaR1C1 = "blabla"
   Range("J6:J" & Endzeile).FormulaLocal = "blabla"

End If
Cells(2, 5).Select
Ende:
If Err.Number > 0 Then MsgBox "Fehler. Evtl. Tag nicht in den Tagesdaten gefunden?!" & Chr(10) & _
   "Wenn man´s genau nimmt:" & Chr(10) & Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
'ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

Ich danke schon mal für hilfreiche Ratschläge.

[BoskoBiati]

Hallo,

statt:

Code:

Application.ScreenUpdating

Code:

Application.enableEvents

oder eher beides.

[Hardilein]

Hallo

Ich hatte Application.enableEvents erst rausgenommen (bevor die Fehler anfingen), weil ich irgendwo gelesen hatte, sollte man sein lassen, wenn man keine funktionierende Fehlerbehandlung hat. Dann hatte ich den Code leicht geändert und die Fehlersache mit angegeben. Die Events aber eben nicht wieder rein. Das ScreenUpdating hatte ich nur jetzt zur Fehlersuche draußen. Mit den drinnen, vielleicht auch schon kurz vorher (??) hatte ich dann "nur" noch Fehler 5. Und der kam von einer der beiden Zeilen (gerade festgestellt und schon wieder vergessen):

Code:

datezeile = Application.Match("Datum", Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0)
If datezeile > 9 Then Rows("6:" & datezeile - 4).Delete

Wer weiß, jetzt geht´s. Danke

[Rabe]

Hi,

Wer weiß, jetzt geht´s. Danke

ist ja klar, denn genau mit dem EnableEvants werden die mehrfachen Durchläufe abgeschaltet.

[atilla]

Hallo zusammen,

der Code kann unabhängig vom EnableEvents immer wieder zu einem Fehler führen.

Du nutzt im Code an mehreren Stellen Die ApplicationMatch Methode. Wenn die Suche kein Ergebnis liefert, dann kommt es automatisch zu einem Fehler.

Du solltest deswegen für diese Fälle eine Fehlerbehandlung einbauen.
Vom Prinzip her geht es so:

Code:

Sub test()
   Dim datezeile
   datezeile = Application.Match("Datum", Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0)
   If IsNumeric(datezeile) Then
       MsgBox datezeile
   Else
       MsgBox "Datum nicht gefunden"
   End If
End Sub

[Hardilein]

Hallo

OK, deshalb hatte ich ja ganz unten die Ausgabe was für ein Fehler und auch den Hinweis, dass Datum nicht gefunden.

Code:

If Err.Number > 0 Then MsgBox "Fehler. Evtl. Tag nicht in den Tagesdaten gefunden?!" & vbLf & _
  "Wenn man´s genau nimmt:" & vbLf & Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"

Reicht das nicht auch? Deine Angaben, atilla, sind logisch. Würde ich natürlich trotzdem vermeiden wollen, wenn ich es zentral abfangen kann. Was für eine Fehlernummer kommt denn bei Match ohne Ergebnis? Hatte bei den Tests die 5 rausgefunden, aber ob die wegen fehlendem Ergebnis kam...?
Sonst würde der Code halt noch länger werden.

Danke

[atilla]

Hallo Hardilein,

mit der Fehlerbehandlung kannst Du natürlich arbeiten, nur Du erkennst nicht, wo der Fehler aufgetreten ist.
Deshalb wäre es besser, den eventuellen Fehler abzufangen und entsprechend zu verzweigen.

Welche Fehlernummer rauskommt ist mit dem von mir gezeigten Beispiel dann unerheblich.

[Hardilein]

Hallo Atilla,

Bei meiner "Suche" geht es immer nur 
- um einen Wochenbeginn. Man kann sich also höchstens mal vertippen und den Sonntag treffen, der in den seltensten Fällen auftaucht. Dann würde die msgbox mit dem Hinweis auf das Datum reichen.
- Für die Suche nach dem Wort "Datum" in der "Fußzeile" -> datezeile - sollte nichts schief gehen, wen doch habe ich jetzt deine "Zeile" drin.
Wenn ich aber zentral "On Error GoTo Ende" stehen habe wird er mir doch bestimmt zuerst runter springen, den Fehler zeigen und dann erst die If bearbeiten? Kann man das kombinieren? Ich könnte natürlich auch On Error tiefer setzen, find ich aber auch nicht gut.


Danke

[schauan]

Hallo Hardilein,

On Error Goto Ende

springt bei Auftreten eines Fehlers zur Sprungmarke "Ende" und setzt die codeausführung dort fort. Das kannst Du gut mit schrittweiser codeausführung nachvollziehen.

Wenn in diesem Bereich kein Rücksprung programmiert ist, dann wird in diesem Makro nur der code unter "Ende" ausgeführt, also bis End Sub.

Wenn Du zurückspringen willst, oder besser gesagt das Makro, dann kann man
Resume
oder
Resume Next

verwenden. Das erste springt in die Zeile mit dem Fehler, das zweite in die Zeile danach.

Im ersten Fall wäre daher eine Fehlerkorrektur nötig, um eine "Endlosschleife" zu verhindern.

Beispiel:

Code:

Sub test()
Dim a%, b, c
On Error GoTo Ende
a = 20
b = 0
c = a / b
MsgBox c
b = "A"
c = a / b
MsgBox c
Ende:
If Err.Number = 11 Then
  b = 1
  Resume
ElseIf Err.Number <> 0 Then
  c = "Unbekannter Fehler"
  Resume Next
End If
End Sub

[atilla]

Hallo Hardilein,

du hattest geschrieben, dass nach dem einsetzen von Application.EnableEvents es zu keinem Fehler mehr kam und vorher des öfteren.
Meine Einlassung bezog sich auf dies Feststellung von Dir. Ich wollte Dir nur erklären, dass es trotzdem noch zu Fehlern kommen kann.

Unten habe ich meine Vorgehensweise mal in Deinen Code eingearbeitet. Beachte auch die neuen Variablen und deren Deklaration.


 

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Wochentage1, Wochentage2, datezeile
Dim Wochentage As Long, Endzeile As Long
Dim Feld As Range

ActiveSheet.Unprotect
On Error GoTo Ende
MsgBox Target.Row & vbLf & Target.Column & vbLf & Target.Count
If Target.Row = 2 Or Target.Column = 5 Or Target.Count = 1 Then
 datezeile = Application.Match("Datum", Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0)
 If IsNumeric(datezeile) Then
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   If datezeile > 9 Then Rows("6:" & datezeile - 4).Delete                                         'Löschen der Zeilen
   If Not IsEmpty(Cells(2, 5)) Then
      datezeile = Application.Match("Datum", Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0)
      If IsNumeric(datezeile) Then
         MsgBox "bin drin"
         Range("C" & datezeile & ":H" & datezeile).ClearContents
         Range("C" & datezeile & ":H" & datezeile).Borders(xlInsideVertical).LineStyle = xlNone
         Wochentage1 = Application.Match(CLng(CDate(Mid$(Cells(2, 7), 8))), Worksheets("Tagesdaten").Range("A:A"), 1)
         If IsNumeric(Wochentage1) Then
           Wochentage2 = Application.Match(Cells(2, 5), Worksheets("Tagesdaten").Range("A:A"), 0)
           If IsNumeric(Wochentage2) Then
             Wochentage = Wochentage1 - Wochentage2 + 1
             Endzeile = 6 + Wochentage - 1
             Rows("6:" & Endzeile).Insert
             
             Range("A6:A" & Endzeile).NumberFormat = "d/;;;"
             Range("B6:B" & Endzeile & ",G6:G" & Endzeile & ",C6:C" & Endzeile & ",J6:J" & Endzeile).NumberFormat = "General"
             Range("D6:D" & Endzeile & ",E6:E" & Endzeile).NumberFormat = "0.00;;;"
             Range("F6:F" & Endzeile).NumberFormat = "[>10]\*\*0.00;[>0]0.00;;"
             Range("H6:H" & Endzeile & ",I6:I" & Endzeile).NumberFormat = "0.00;0;;@"
             
             Set Feld = Range("A6:J" & Endzeile)
             Feld.Font.Bold = False
             
             With Feld.Borders(xlEdgeLeft)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
             End With
             With Feld.Borders(xlEdgeRight)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
             End With
             With Feld.Borders(xlEdgeTop)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
             End With
             With Feld.Borders(xlEdgeBottom)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
             End With
             With Feld.Borders(xlInsideVertical)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
             End With
             With Feld.Borders(xlInsideHorizontal)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
             End With
             Range("A6:A" & Endzeile).FormatConditions.Delete
             Range("A6:A" & Endzeile).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=$A5"
             Range("A6:A" & Endzeile).FormatConditions(1).Font.ColorIndex = 2
             
             Range("A6:A" & Endzeile).FormulaLocal = "=blabla"
             Range("B6:B" & Endzeile).FormulaR1C1 = "=blabla"
             Range("C6:C" & Endzeile).FormulaLocal = "=blabla"
             Range("D6:D" & Endzeile).FormulaR1C1 = "=blabla"
             Range("E6:E" & Endzeile).FormulaR1C1 = "=blabla"
             Range("F6:F" & Endzeile).FormulaR1C1 = "blabla"
             Range("G6:G" & Endzeile).FormulaR1C1 = "=blabla"
             Range("H6:H" & Endzeile).FormulaR1C1 = "=blabla"
             Range("I6:I" & Endzeile).FormulaR1C1 = "blabla"
             Range("J6:J" & Endzeile).FormulaLocal = "blabla"
             Cells(2, 5).Select
           Else
             MsgBox "In Tagesdaten wurde Wochentag aus Zelle E2 nicht gefunden!"
           End If
         Else
           MsgBox "In Tagesdaten wurde Wochentag aus Zelle G2 nicht gefunden!"
         End If
     Else
       MsgBox "Nach dem löschen der Zeilen wurde der Begriff " & """" & "Datum " & """" & " nicht gefunden!"
     End If
   End If
 Else
   MsgBox "Der Begriff " & """" & "Datum " & """" & "wurd nicht gefunden!"
 End If
End If
Ende:
 Application.EnableEvents = True
 Application.ScreenUpdating = True

 If Err.Number > 0 Then MsgBox "Fehler. Evtl. Tag nicht in den Tagesdaten gefunden?!" & Chr(10) & _
  "Wenn man´s genau nimmt:" & Chr(10) & Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
'ActiveSheet.Protect
End Sub

Wie gesagt, kannst Du aber auch mit Deiner kurzen Variante arbeiten.
Du musst nur beachten, dass die abgeschalteten Ereignisse am besten in der Fehlerbehandlung eingeschaltet werden sollten, so, wie es bei mir aussieht.