[Excel] farbige Formatierung: Vergleich von bedingter Formatierung und VBA-Makro
#1
Zusammengefasst aus zwei Beiträgen von RPP63:
http://www.clever-excel-forum.de/thread-...l#pid45678
http://www.clever-excel-forum.de/thread-...l#pid45703

Formatierung einer Zelle in Abhängigkeit vom Inhalt:

1.) Bedingte Formatierung
Spalte markieren,
Bedingte Formatierung, neue Regel, Formel ist:
=RECHTS(A1;3)="xls"
Farbe zuweisen,


A
1XXX.jpg
2XXX.xls
3XXX.doc

Zellebedingte Formatierung...Format
A11: =RECHTS(A1;3)="doc"abc
A12: =RECHTS(A1;3)="jpg"abc
A13: =RECHTS(A1;3)="xls"abc
A21: =RECHTS(A2;3)="doc"abc
A22: =RECHTS(A2;3)="jpg"abc
A23: =RECHTS(A2;3)="xls"abc
A31: =RECHTS(A3;3)="doc"abc
A32: =RECHTS(A3;3)="jpg"abc
A33: =RECHTS(A3;3)="xls"abc


2.) VBA-Makros:

Gängige RGB-Werte (hier für RAL-Farbnummern) sind hier zu finden:
https://www.visual-graphics.de/de/servic...arbtabelle

Falls die Liste bereits besteht (allgemeines Modul):
Sub RPP()
Dim Zelle As Range
For Each Zelle In Intersect(Tabelle2.UsedRange, Tabelle2.Columns("A"))
   Select Case Right(Zelle, 3)
      Case "jpg": Zelle.Interior.Color = RGB(255, 0, 0)
      Case "xls": Zelle.Interior.Color = RGB(0, 255, 0)
      Case "doc": Zelle.Interior.Color = RGB(0, 0, 255)
      Case "mp3": Zelle.Interior.Color = RGB(20, 50, 70)
      ' weitere Fälle 
   End Select
Next
End Sub

Für neue Einträge ginge folgendes Ereignismakro
(Rechtsklick auf Tabellenreiter, Code anzeigen)

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If .Column = 1 And .Count = 1 Then
      Select Case Right(.Value, 3)
         Case "jpg": .Interior.Color = RGB(255, 0, 0)
         Case "xls": .Interior.Color = RGB(0, 255, 0)
         Case "doc": .Interior.Color = RGB(0, 0, 255)
         Case "mp3": .Interior.Color = RGB(20, 50, 70)
         ' weitere Fälle 
         Case "": .Interior.Color = xlNone 'Farbe entfernen 
      End Select
   End If
End With
End Sub
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste