AW: doppelte Inhalte bunt markieren
09.02.2007 01:00:34
Erich
Hallo Herbert,
das würd ich dann mit VBA machen.
Bei "so" wird abgebrochen, wenn die Farben (Nr. 3 bis 55) einmal verbraucht sind,
bei "oder so" werden die Farben mehrfach verwendet, auch für unterschiedliche Gruppen von Zellen.
(Eine dieser beiden Zellen muss immer auskommentiert sein):
Option Explicit
Sub Mehrfache_faerben()
Dim lngZ As Long, intS As Integer, intF As Integer, lngV As Long, varW, zz As Long
Const intSp As Integer = 1 ' 1 für Spalte A, anpassen
lngZ = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(1, intSp), Cells(lngZ, intSp)).Interior.ColorIndex = xlColorIndexNone
Columns(1).Insert
With Range(Cells(1, intSp), Cells(lngZ, intSp))
.Formula = "=ROW()"
.Value = .Value
End With
intS = intSp + 1
Range(Rows(1), Rows(lngZ)).Sort Key1:=Cells(1, intS), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom
intF = 2
lngV = 1
varW = Cells(1, intS)
For zz = 2 To lngZ + 1
If varW <> Cells(zz, intS) Then
If zz > lngV + 1 Then
If intF < 55 Then intF = intF + 1 Else Exit For ' so
'intF = IIf(intF < 55, intF + 1, 3) ' oder so
Range(Cells(lngV, intS), Cells(zz - 1, intS)).Interior.ColorIndex = intF
End If
lngV = zz
varW = Cells(zz, intS)
End If
Next zz
Range(Rows(1), Rows(lngZ)).Sort Key1:=Cells(1, intSp), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns(intSp).Delete
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort