gleiche Zelleninhalte gleiche Farbe
Reinhard
Hi Forsa,
Alt+F11, Einfügen Modul, nachstehenden Code dort reinkopieren, Vb-Editor schliessen.
In Excel: Extras--Makro--Makro--farben() auswählen und "Bearbeiten".
Jetzt in der Zeile
farb = Array(8, 36, 45, 37, 2, 3, 4, 7)
ggfs weitere Farben reinschreiben, wie ersichtlich mit komma getrennt. Großzügig mehr Farben festlegen als in der Tabelle sein werden, sonst Makromsgbox.
Derzeit arbeitet das Makro in Spalte A, bei einer anderen Splalte in der Zeile
spa=1
die 1 durch die SpaltenNUMMER der Splate ersetzen
Gruß
Reinhard
Option Base 1
Sub farben()
Dim versch() 'Anzahl verschiedener Werte
Dim farb
farb = Array(8, 36, 45, 37, 2, 3, 4, 7) ' hier die Farbwerte, bis zu 56 möglich
spa = 1
letzte = Cells(65536, spa).End(xlUp).Row
Range(Cells(1, spa), Cells(letzte, spa)).Interior.ColorIndex = xlNone
ReDim Preserve versch(1)
versch(1) = Cells(1, spa) ' erste Zahl in versch()
For n = 2 To letzte 'Schleife, wieviele verschiedene Zahlen gibt es
vorh = False
For nn = 1 To UBound(versch) ' ist Zahl schon in versch()
If Cells(n, spa) = versch(nn) Then vorh = True
Next nn
If vorh = False Then 'wenn Zahl "neu" rein in versch()
ReDim Preserve versch(UBound(versch) + 1)
versch(UBound(versch)) = Cells(n, spa)
End If
Next n
If UBound(versch) <= UBound(farb) Then
For n = 1 To letzte ' Schleife zum Färben
For nn = 1 To UBound(versch)
If Cells(n, spa) = versch(nn) Then Cells(n, spa).Interior.ColorIndex = farb(nn)
Next nn
Next n
Else
MsgBox "Mehr Farben in tabelle als in Farb-Array eingetragen"
End If
End Sub