ich habe ein Arbeitsblatt wo Zellen in verschiedenen Farben markiert sind.
Wer hat mir ein Makro mit welchem ich die Anzahl der Zellen pro Farbe
anzeigen kann.
Das wäre super.
Besten Dank im voraus
Jens
Public Sub FarbigeZaehlen()
Dim Dict As Variant
Dim WkSh As Worksheet
Dim rBereich As Range
Dim rZelle As Range
Dim lZeile As Long
Set Dict = CreateObject("Scripting.Dictionary") ' Zuordnung an Scripting Dictionary
Set WkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
Set rBereich = WkSh.Range("A1:I20") ' den Bereich an die Gegebenheiten anpassen
For Each rZelle In rBereich
If rZelle.Interior.ColorIndex xlNone Then
Dict(rZelle.Interior.ColorIndex) = Dict(rZelle.Interior.ColorIndex) + 1
End If
Next rZelle
Set rZelle = WkSh.Range("J1") ' die erste Ausgabezelle festlegen
rZelle.Resize(Dict.Count) = WorksheetFunction.Transpose(Dict.Keys)
rZelle.Offset(0, 1).Resize(Dict.Count) = WorksheetFunction.Transpose(Dict.Items)
For lZeile = 1 To WkSh.Cells(Rows.Count, 10).End(xlUp).Row
WkSh.Range("J" & lZeile).Interior.ColorIndex = _
CInt(WkSh.Range("J" & lZeile).Value)
Next lZeile
End Sub
Achtung: Das Ergebnis der Zählung wird in J1:Kx ausgegeben