Fehler überspringen

Hallo Christopher,
ich habe den Fehler gefunden. Der Zeilenindex - Erhöher
lR = lR + 1
stand innerhalb des IF-Blockes. Dadurch wird das DO-LOOP eine Endlosschleife, da Excel ewig in der ersten nicht-leeren Zelle hängen bleibt.
Hier der neue Code, Änderung (einfach 2x 2 Zeilen getauscht!) fett:


Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer
Dim sMldg3 As String, sMldg4 As String, iDiff1 As Integer
Dim arrJub(1 To 6) As Integer, intI As Integer
Const iVn As Integer = 3   ' Spalte C - Vornamen
Const iNn As Integer = 2   ' Spalte D - Nachnamen
Const iG As Integer = 7    ' Spalte H - Geburtstage
Const iEin As Integer = 8  ' Spalte I - Eintrittsdatum
arrJub(1) = 10    ' 10-jähriges Jubiläum
arrJub(2) = 20    ' 20-jähriges Jubiläum
arrJub(3) = 25    ' 25-jähriges Jubiläum
arrJub(4) = 30    ' 30-jähriges Jubiläum
arrJub(5) = 40    ' 40-jähriges Jubiläum
arrJub(6) = 50    ' 50-jähriges Jubiläum
ActiveSheet.Protect Password:=""
Beep
' Überprüfung auf Geburtstage (dieses Makro hab ich hier im Forum gefunden)
sMldg1 = "Geburtstage:" & vbLf
lR = 2
Do Until IsEmpty(Cells(lR, iVn))
If IsDate(Cells(lR, iVn)) Then
iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date
If iDiff      End If
lR = lR + 1
Loop
If sMldg1 = "Geburtstage:" & vbLf Then sMldg1 = "Heute kein Geburtstag!"
If MsgBox(sMldg1, vbOKCancel, "Info") = vbOK Then
If sMldg2  "" Then
MsgBox "Geburtstage in den nächsten 31 Tagen:" & vbLf & sMldg2, , "Vorschau"
Else
MsgBox "Keine Geburtstage in den nächsten 31 Tagen!", , "Info"
End If
End If
' Überprüfung auf  Jubiläen
sMldg3 = "Jubiläum:" & vbLf
lR = 2
Do Until IsEmpty(Cells(lR, iVn))
If IsDate(Cells(lR, iVn)) Then
For intI = LBound(arrJub) To UBound(arrJub)
iDiff1 = DateSerial(Year(Cells(lR, iEin)) + arrJub(intI), Month(Cells(lR, iEin)), _
Day(Cells(lR, iEin))) - Date
If iDiff1      End If
lR = lR + 1
Loop
If sMldg3 = "Jubiläum:" & vbLf Then sMldg3 = "Heute kein Jubiläum!"
If MsgBox(sMldg3, vbOKCancel, "Info") = vbOK Then
If sMldg4  "" Then
MsgBox "Jubiläen in den nächsten 31 Tagen:" & vbLf & sMldg4, , "Vorschau"
Else
MsgBox "Keine Jubiläen in den nächsten 31 Tagen!", , "Info"
End If
End If

Übrigens: ich bin, unter anderem aus diesem Grund, kein Freund von DO-LOOP Schleifen. Ich finde die einfach unübersichtlich. Den o.g. Code könnte man leicht auf FOR-NEXT Schleifen umstellen und auf diesen Zeilenindexzähler ganz verzichten (soll ich?).
Übrigens 2: ein so langer Code gehört nicht in "Workbook Open". Aus Prinzip nicht! Pack den lieber in ein eigenes Modul unter einem sprechenden Namen, und Calle das Makro aus WorkbookOpen. Macht - in diesem Fall - zwar Null unterschied, aber man sollte sich schnell angewöhnen seine Ereignissprozeduren übersichtlich zu halten. Auto-Analogie: Wenn die Karre total verdreckt ist, fährt sie trotzdem genausogut wie vorher. Eine Fahrt durch die Waschstrasse schadet aber nicht.
Grüße,
Klaus M.vdT.

Hi Christopher,
ich weiss da kannst du nichts für, aber:
die Variablenbeschriftung in dem Makro ist ja unter aller Kanone. Statt der kryptischen "iG" und "iVn" hätten die Variablen gerne "iGeburtstag" und "iVorname" heissen dürfen, dann hätte ich die Fehler gleich gesehen.
Der hier ist auch echt fies:
Const iG As Integer = 7 ' Spalte H - Geburtstage
Const iEin As Integer = 8 ' Spalte I - Eintrittsdatum
natürlich glaube ich dem Kommentar einfach. Weil H eben nicht die siebte Spalte ist, ergab dass dann Unsinn ... glaube keinem Kommentar, den du nicht selbst geschrieben hast! Folgelogik: Code muss nicht kommentiert werden, da es eh keiner glaubt ... ehm, das nehme ich zurück!
Im vorherigen Code wird mit "ISDATE" noch der Vorname geprüft, das macht natürlich keinen Sinn. Vornamen sind nur ganz selten gültige Datümer, und wenn dann waren die Eltern echt fies.
Hier jetzt nochmal der Code, der tatsächlich funktioniert. Ich habe auch diese schrecklichen DO-LOOP rausgeworfen und gegen FOR-NEXT ersetzt.

Sub GebUndJubHolen()
Dim sMldg1 As String, sMldg2 As String, lR As Long, iDiff As Integer
Dim sMldg3 As String, sMldg4 As String, iDiff1 As Integer
Dim arrJub(1 To 6) As Integer, intI As Integer
Dim lRowLast As Long
Dim lRowFirst As Long
Const iVn As Integer = 3   ' Spalte C - Vornamen
Const iNn As Integer = 2   ' Spalte D - Nachnamen
Const iG As Integer = 7    ' Spalte H - Geburtstage
Const iEin As Integer = 8  ' Spalte I - Eintrittsdatum
arrJub(1) = 10    ' 10-jähriges Jubiläum
arrJub(2) = 20    ' 20-jähriges Jubiläum
arrJub(3) = 25    ' 25-jähriges Jubiläum
arrJub(4) = 30    ' 30-jähriges Jubiläum
arrJub(5) = 40    ' 40-jähriges Jubiläum
arrJub(6) = 50    ' 50-jähriges Jubiläum
'ActiveSheet.Protect Password:=""
Beep
' Überprüfung auf Geburtstage (dieses Makro hab ich hier im Forum gefunden)
sMldg1 = "Geburtstage:" & vbLf
'erste Zeile
lRowFirst = 2
'letzte Zeile
lRowLast = Cells(Rows.Count, iG).End(xlUp).Row
For lR = lRowFirst To lRowLast
If IsDate(Cells(lR, iG)) Then 'auf IG geändert!
iDiff = DateSerial(Year(Date), Month(Cells(lR, iG)), Day(Cells(lR, iG))) - Date
If iDiff  "" Then
MsgBox "Geburtstage in den nächsten 31 Tagen:" & vbLf & sMldg2, , "Vorschau"
Else
MsgBox "Keine Geburtstage in den nächsten 31 Tagen!", , "Info"
End If
End If
' Überprüfung auf  Jubiläen
sMldg3 = "Jubiläum:" & vbLf
'letzte Zeile
lRowLast = Cells(Rows.Count, iEin).End(xlUp).Row
For lR = lRowFirst To lRowLast
If IsDate(Cells(lR, iEin)) Then 'auf iEin geändert
For intI = LBound(arrJub) To UBound(arrJub)
iDiff1 = DateSerial(Year(Cells(lR, iEin)) + arrJub(intI), Month(Cells(lR, iEin)), _
Day(Cells(lR, iEin))) - Date
If iDiff1  "" Then
MsgBox "Jubiläen in den nächsten 31 Tagen:" & vbLf & sMldg4, , "Vorschau"
Else
MsgBox "Keine Jubiläen in den nächsten 31 Tagen!", , "Info"
End If
End If
End Sub

Grüße,
Klaus M.vdT.

Forumthread: Fehler überspringen

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial