Excel : Text nach Extension (Erweiterung) farbig darstellen

[Sir Anthony]

Hallo Excel Spezialisten ich benötige eure Hilfe
 
Situation
Ich habe eine Excelliste wo ich Teile der Festplatte ausgelesen und eingetragen habe.
Nun hätte ich gerne die Eintragungen nach Extension (Erweiterung) farblich dargestellt.
 
Beispiel
 
XXX.jpg soll farbig Text 3 (rot)
XXX.xls soll farbig Text 14 (grün)
XXX.doc soll farbig Text 5 (blau)
usw dargestellt werden.
 
Wie kann ich dies lösen, wo und wie müsste ich Eintragungen vornehmen.
Auf meinen PCs ist Excel 2003 und Excel 2013 installiert.
 
Vielen Dank schon im Voraus
 
Sir Anthony

[RPP63]

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

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

Zelle	bedingte Formatierung...	Format
A1	1: =RECHTS(A1;3)="doc"	abc
A1	2: =RECHTS(A1;3)="jpg"	abc
A1	3: =RECHTS(A1;3)="xls"	abc
A2	1: =RECHTS(A2;3)="doc"	abc
A2	2: =RECHTS(A2;3)="jpg"	abc
A2	3: =RECHTS(A2;3)="xls"	abc
A3	1: =RECHTS(A3;3)="doc"	abc
A3	2: =RECHTS(A3;3)="jpg"	abc
A3	3: =RECHTS(A3;3)="xls"	abc

Gruß Ralf

[Sir Anthony]

Danke für den Tipp, nur leider funktioniert dies nicht so wie ich es mir vorstelle, da man ja nur 3 bedingte Formatierungen zur Verfügung hat und ich doch über 10 benötigen würde.

Sir Anthony

[RPP63]

Hallo!
Nicht ganz Ernst gemeint:
Willst Du die 13 Jahre alte Software, für die es keine Sicherheitsupdates mehr gibt, nicht mal einmotten?
Empfindest Du 10 verschiedene Farben als noch übersichtlich?

Sei es drum, dies geht dann nur mittels VBA.
Gängige RGB-Werte (hier für RAL-Farbnummern) findest Du hier:
https://www.visual-graphics.de/de/servic...arbtabelle

Falls die Liste bereits besteht:

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

Gruß Ralf

[schauan]

Hallo Sir,

da Du auf Deinem PC 2003 und 2013 hast, würde ich die Datei mit 2013 bearbeiten und dort hast Du 64 Möglichkeiten.

[RPP63]

Moin André!

Wenn Abwärtskompatibilität benötigt wird, geht es nur mittels VBA.
Allerdings schrieb ich ja auch etwas zum "Entsorgen" der Uralt-Version

Gruß Ralf