Zellen Hintergrund färben

panscher · 02.11.2005

Hallo,

ich bin gerade dabei einen Diensplan zu erstellen.

Jeder Mitarbeiter hat ein Arbeitsblatt mit einem Kalender.

1 2 3 4 5 6 7 8 9 usw.
Januar
Februar
usw.

Über die Gültigkeitsprüfung habe ich eine Liste mit U;F;K;FT;Ü angelegt, dann
wähle ich im Kalender U,F,K,FT,Ü für den jeweiligen Tag aus.
Nun möchte ich aber für U,F,K,FT,Ü immer eine andere Hintergrundfarbe haben.
z.b U=grün, F=rot, K=lila usw. Mit der bedingten Formatiertung kommt ich nicht aus, gehen ja nur 3.

Gibts dafür ein Makro?

Dieses Makro sollte meine Kalender von Januar-Dezember / 1-31 abdecken.
Nach Möglichkeit alles automatisch machen, ohne das ich eine Taste drücke.

Martin

Matjes · 02.11.2005

Hallo panscher,

hier ist erstmal ein Beispiel für ein Tabellenblatt. Schau mal ob du es für deine Belange anpassen kannst.

http://www.wintotal-forum.de/index.php/topic,78827.0.html

Wenn Du damit Schwierigkeiten hast, nochmal melden.

Den Umbau auf mehrere Tabellenblätter im zweiten Schritt.

Gruß Matjes

panscher · 03.11.2005

Hallo,

das Makro funktioniert super, aber leider ändert er mir nur die Farbe im Tag 1 des Kalenders, aber dafür die ganzen Monate durch. Nur bei Tag 2-31 ändert sich die Farbe nicht, obwohl ich den Bereich B11:AF22 angegeben habe.

Gruss Martin

Matjes · 03.11.2005

Hallo martin,

schick mir die Tabelle mal an mein mailaddy. Ich schau mal woran es liegt.

Gruß Matjes

Matjes · 05.11.2005

Hallo Martin,

für die Überwachung eines Blattes könnte der Makro so aussehen:

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
  
  Dim bereich As String, zelle As Range
  Dim start_r As Long, max_r As Long, r As Long
  Dim start_c As Long, max_c As Long, c As Long
  
  bereich = B7:AF18
  
 ->Anfangs- und End- Zeile/Spalte des zu ueberwachenden Bereichs bestimmen
  start_r = ActiveSheet.Range(bereich).Row
  max_r = ActiveSheet.Range(bereich).Row + ActiveSheet.Range(bereich).Rows.Count - 1
  start_c = ActiveSheet.Range(bereich).Column
  max_c = ActiveSheet.Range(bereich).Column + ActiveSheet.Range(bereich).Columns.Count - 1
  
  For Each zelle In Target
    
    With zelle
    
     ->pruefen: im Bereich
      If start_r &lt;= .Row And .Row &lt;= max_r Then
        If start_c &lt;= .Column And .Column &lt;= max_c Then
          
         ->Hintergrundfarbe setzen, wenn nicht schon gesetzt
          If LCase(.Value) = u Then
            .Interior.ColorIndex = 6
          ElseIf LCase(.Value) = f Then
            .Interior.ColorIndex = 4
          ElseIf LCase(.Value) = k Then
            .Interior.ColorIndex = 3
          ElseIf LCase(.Value) = ü Then
            .Interior.ColorIndex = 9
          ElseIf .Value = - Then
            .Interior.ColorIndex = 0
          ElseIf LCase(.Value) = nicht relevant Then
            .Interior.ColorIndex = 0
          ElseIf LCase(.Value) =  Then
            .Interior.ColorIndex = 0
          End If
        End If
      End If
    End With
  Next
  Set zelle = Nothing
End Sub

Dieses Makro muß in der Code-Seite des Blattes liegen.
Am einfachsten gelangt man dorthin, indem man auf die Blattlasche mit der rechten Maustaste klickt und->Code anzeigen' wählt.

Um mehrere gleiche Blätter zu überwachen, kannst du den folgenden Makro einsetzen. Dann sollte in den Code-Seiten der Blätter kein Makro stehen (solcher wie oben).
Dieser Makro muß in der Code-Seite der Mappe stehen (DieseArbeitsmappe)
'a) betreffende Excel-Datei öffnen
'b) mit Alt+F11 VB-Editor öffnen
'd) im Projekt-Fenster
' unter VBAProject(betreffende Excel-Datei)
' mit einem Doppelklick auf->DieseArbeitsmappe'
' die Code-Seite der Arbeitsmappe öffnen
'e) Das Makro dort hineinkopieren
'f) mit Alt+S speichern
'g) mit Alt+Q VB-Editor schliessen
'h) ausprobieren

Gruß Matjes

Code:

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
  Dim bereich As String, zelle As Range
  Dim start_r As Long, max_r As Long, r As Long
  Dim start_c As Long, max_c As Long, c As Long
  Dim BlattNamen As Variant, x As Long
  
  BlattNamen = _
    Array(Januar, Februar, März, April, Mai, Juni, Juli, _
          August, September, Oktober, November, Dezember)
  
 ->prüfen, ob Blattname unter Überwachung steht
  For x = LBound(BlattNamen) To UBound(BlattNamen)
    If BlattNamen(x) = Sh.Name Then GoTo BEARBEITEN
  Next
  
  Exit Sub
  
BEARBEITEN:

  bereich = B7:AF18
  
 ->Anfangs- und End- Zeile/Spalte des zu ueberwachenden Bereichs bestimmen
  start_r = ActiveSheet.Range(bereich).Row
  max_r = ActiveSheet.Range(bereich).Row + ActiveSheet.Range(bereich).Rows.Count - 1
  start_c = ActiveSheet.Range(bereich).Column
  max_c = ActiveSheet.Range(bereich).Column + ActiveSheet.Range(bereich).Columns.Count - 1
  
  For Each zelle In Target
    
    With zelle
    
     ->pruefen: im Bereich
      If start_r &lt;= .Row And .Row &lt;= max_r Then
        If start_c &lt;= .Column And .Column &lt;= max_c Then
          
         ->Hintergrundfarbe setzen, wenn nicht schon gesetzt
          If LCase(.Value) = u Then
            .Interior.ColorIndex = 6
          ElseIf LCase(.Value) = f Then
            .Interior.ColorIndex = 4
          ElseIf LCase(.Value) = k Then
            .Interior.ColorIndex = 3
          ElseIf LCase(.Value) = ü Then
            .Interior.ColorIndex = 9
          ElseIf .Value = - Then
            .Interior.ColorIndex = 0
          ElseIf LCase(.Value) = nicht relevant Then
            .Interior.ColorIndex = 0
          ElseIf LCase(.Value) =  Then
            .Interior.ColorIndex = 0
          End If
        End If
      End If
    End With
  Next
  Set zelle = Nothing
End Sub

Zellen Hintergrund färben

panscher

Matjes

panscher

Matjes

Matjes

Zellen Hintergrund färben

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums