title image


Smiley Re: Zellen selektiv einfärben jede 4 . Zeile
... und noch zwei Fehler weniger - wenn am 1. Samstag oder Sonntag ist geht es jetzt auch und nach dem 31. werden auch keine Zellen mehr gefärbt:

Sub faerben()

Dim i%, y%

'Rücksetzten aller Farben, ggf. Bereich einschränken!

Cells.Interior.ColorIndex = xlNone

If WorksheetFunction.Weekday(CDate(1 & "." & [c2] & "." & [k2])) = vbSunday Then

i = -1

For y = 5 To 141 Step 4

Cells(y, i + 2 + 5).Interior.ColorIndex = 8

Next

End If

If WorksheetFunction.Weekday(CDate(1 & "." & [c2] & "." & [k2])) = vbSaturday Then

i = 0

For y = 5 To 141 Step 4

Cells(y, i + 1 + 5).Interior.ColorIndex = 34

Cells(y, i + 2 + 5).Interior.ColorIndex = 8

Next

End If

For i = 6 To 36

On Error GoTo ende

If WorksheetFunction.Weekday(CDate(i - 5 & "." & [c2] & "." & [k2])) = vbFriday Then

On Error GoTo 0

For y = 5 To 141 Step 4

Cells(y, i).Interior.ColorIndex = 36

If i + 1 < 36 Then Cells(y, i + 1).Interior.ColorIndex = 34

If i + 2 < 36 Then Cells(y, i + 2).Interior.ColorIndex = 8

Next

End If

Next

Exit Sub

ende:

'Fehler 13 kommt bei Monatsende vor dem 31.

If Err.Number 13 Then MsgBox "Fehler " & Err.Number & vbLf & Err.Description

End Sub

Grüße,Andre
[Hochgeladenes Bild]

Grüße von André aus Gera - 97 - 2003


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: