|
In der Arbeitsmappe im Klassenmodul "DieseArbeitsmappe" eintragen:
Option Explicit
Private Sub Workbook_Open()
Dim lngSpaltenZahl As Long
With ThisWorkbook.Sheets("Tabelle1") 'Hier ggf. den Namen des Tabellenblattes ändern
For lngSpaltenZahl = 2 To 84
If Application.WorksheetFunction.Count(.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl))) = 0 Then
.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = 3
Else
.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = xlNone
End If
Next lngSpaltenZahl
End With
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngSpaltenZahl As Long
If Sh.Name <> "Tabelle1" Then Exit Sub 'Hier ggf. den Namen des Tabellenblattes ändern
With Sh
If Target.Row < 13 Or Target.Row > 17 Or Target.Column < 2 Or Target.Column > 84 Then Exit Sub
For lngSpaltenZahl = 2 To 84
If Application.WorksheetFunction.Count(.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl))) = 0 Then
.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = 3
Else
.Range(.Cells(13, lngSpaltenZahl), .Cells(17, lngSpaltenZahl)).Interior.ColorIndex = xlNone
End If
Next lngSpaltenZahl
End With
End Sub
Severus
|