Leute! Warum könnt ihr nicht von Anfang an klar sagen, was ihr wollt? Muß man immer wieder nachbessern, weil Ihr Eure Aufgabenstellung nicht durchdenkt oder nicht richtig beschreibt? Das frustriert ungemein, weil man sich vera...t vorkommt, wenn immer wieder "und dann noch, und könnte man nicht noch usw. usw. " nachkommen!
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
If Application.WorksheetFunction.Count(.Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl))) = 0 Then
.Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl)).Interior.ColorIndex = 3
Else
.Range(.Cells(32, lngSpaltenZahl), .Cells(37, 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 And Target.Row < 32) Or Target.Row > 37 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
If Application.WorksheetFunction.Count(.Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl))) = 0 Then
.Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl)).Interior.ColorIndex = 3
Else
.Range(.Cells(32, lngSpaltenZahl), .Cells(37, lngSpaltenZahl)).Interior.ColorIndex = xlNone
End If
Next lngSpaltenZahl
End With
End Sub
Es handelt sich nicht um zwei Lösungsmöglichkeiten! Die eine Prozedur wird beim Öffnen der Datei ausgeführt, damit die Anzeigen korrekt sind. Die andere wird ausgeführt, wenn das Blatt geändert wird. Beide Prozeduren müssen in das Modul "DieseArbeitsmappe" kopiert werden.
Severus
|