Mehr als 3 Formate und Blattwechsel

Hallo Forum
Ich kriegs einfach nicht hin. Ich möchte in einem Blatt mehr als 3 bedingte Formate anlegen. Die Zellinhalte werden mit Formeln von einem anderen Blatt gespiesen. Ich habe im Forum ein Makro gefunden und in das Blatt eingefügt, es läuft aber nur, wenn ich im Blatt selber eine Eingabe mache. Ich habe mit Workook_SheetDeaktivate und allem möglichen probiert, dann erhalte ich aber jeweils Fehlermeldungen. Wie muss ich das Makro anlegen, dass es bei einem Blattwechsel ausgführt wird?


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngCell As Range
Dim bytColor As Byte
'Bereich der überwacht wird
Set Target = Intersect(Target, .Range("F2:Q33"))
If Target Is Nothing Then Exit Sub
For Each rngCell In Target
Select Case rngCell.Value
Case 1 To 2
bytColor = 1 'schwarz
Case 3 To 4
bytColor = 2  'weiss
Case 5 To 6
bytColor = 3  'rot
Case 7 To 8
bytColor = 4  'grün
Case 9 To 10
bytColor = 5  'blau
Case 11 To 12
bytColor = 6  'gelb
Case 13 To 14
bytColor = 7  'rosa
Case 15 To 16
bytColor = 8  'cyan
End Select
rngCell.Interior.ColorIndex = bytColor
Next rngCell
End Sub

Besten Dank für eure Hilfe
Gruess, Hans

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim rngCell As Range Dim bytColor As Byte 'Bereich der überwacht wird For Each rngCell In Sh.Range("F2:Q33") Select Case rngCell.Value Case 1 To 2 bytColor = 1 'schwarz Case 3 To 4 bytColor = 2 'weiss Case 5 To 6 bytColor = 3 'rot Case 7 To 8 bytColor = 4 'grün Case 9 To 10 bytColor = 5 'blau Case 11 To 12 bytColor = 6 'gelb Case 13 To 14 bytColor = 7 'rosa Case 15 To 16 bytColor = 8 'cyan End Select rngCell.Interior.ColorIndex = bytColor Next rngCell End Sub

Hallo Hans!
Wenn die Zellen per Formel berechnet werden, dann geht's so!
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Calculate()
Dim rngCell As Range
Dim bytColor As Byte

For Each rngCell In Range("F2:Q33") 'Bereich der überwacht wird
  Select Case rngCell.Value

    Case 1 To 2
      bytColor = 1 'schwarz
    Case 3 To 4
      bytColor = 2 'weiss
    Case 5 To 6
      bytColor = 3 'rot
    Case 7 To 8
      bytColor = 4 'grün
    Case 9 To 10
      bytColor = 5 'blau
    Case 11 To 12
      bytColor = 6 'gelb
    Case 13 To 14
      bytColor = 7 'rosa
    Case 15 To 16
      bytColor = 8 'cyan
  End Select

  rngCell.Interior.ColorIndex = bytColor

Next
End Sub

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Beliebteste Forumthreads (12 Monate)

Mehr als 3 Formate und Blattwechsel

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread