AW: Besen, Besen, sei's gewesen...
11.10.2005 21:11:16
Matthias
Hallo Karen,
nachdem Ralf wohl noch isst, wollte ich mal dessen gute Vorarbeit ausnutzen und einen weiteren anderen Lösungsvorschlag anbringen.
Ich nutze dazu das Ereignis Workbook_SheetChange, das bei jeder Änderung einer Zelle in der Mappe ausgelöst wird.
Dann frage ich den Tabellenblattnamen sowie den geänderten Bereich ab. Wurde im überwachten Bereich etwas geändert, suche ich den (per Formel) rechts davon erscheinenden Begriff in der Tabelle "Daten1" in den Spalten B bis H. Wurde er gefunden, lese ich die (von dir noch einzutragende) Zahl rechts neben dem Begriff im Blatt Daten1 aus und nehme diesem als Colorindex für den Hintergrund.
Der Code (muss in "DieseArbeitsmappe"):
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Ueberwache As Range, ber As Range
Dim suchrng As Range
'beginnt Blatt mit "KW"?
If Left(Sh.Name, 2) = "KW" Then
'Überwachungsbereich definieren
Set Ueberwache = Union(Sh.Range("G7:G46"), _
Sh.Range("I7:I46"), _
Sh.Range("K7:K46"), _
Sh.Range("M7:M46"), _
Sh.Range("O7:O46"))
'ber = Schnittmenge aus geänderten Zellen und Überwachungsbereich
Set ber = Intersect(Ueberwache, Target)
'ber nicht leer?
If Not ber Is Nothing Then
'Durchlaufe ede Zelle in "ber"
For Each z In ber
'Such in Daten1!B:H nach danebenstehendem Begriff
Set suchrng = Sheets("Daten1").Range("B:H").Find(What:=z.Offset(0, 1).Text)
'nicht gefunden, dann ohne Hintergrundfarbe
If suchrng Is Nothing Then
z.Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
'Eintrag rechts des Suchbegriffs leer, dann auch ohne Hintergrundfarbe
ElseIf suchrng.Offset(0, 1) = "" Then
z.Offset(0, 1).Interior.ColorIndex = xlColorIndexNone
'sonst: Hintergrundfarbindex = Zahl neben gefundenem Begiff
Else
z.Offset(0, 1).Interior.ColorIndex = Val(suchrng.Offset(0, 1))
End If
Next z
End If
End If
End Sub
Dein Blatt "Daten1" sähe dann so aus (Ausschnitt):
|
| |
| | D | E | F | | 1 | Nr. | Ressource | | | 2 | 1 | EDV | 19 | | 3 | 2 | Stapler | 12 | | 4 | 3 | Werkstatt | 13 | | 5 | 4 | Übungslager | 14 | | 6 | 5 | LKW | 15 | | 7 | 6 | Theorie | 16 | | 8 | 7 | | | |
| |
Gruß Matthias