Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1184to1188
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Anzahl farbige Zellen zählen

Anzahl farbige Zellen zählen
Jens-Claus
Hallo Excelfreunde,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Anzahl farbige Zellen zählen
04.11.2010 17:31:51
Peter
Hallo Jens,
wenn die Farben manuell gesetzt wurden und nicht durch bedingte Formatierung, könnte es so funktionieren:
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
Gruß Peter
Anzeige
AW: Anzahl farbige Zellen zählen
04.11.2010 18:56:08
Jens-Claus
Hallo Peter,
herzlichen Dank für das Supermakro.
Funktioniert bestens.
Einen schönen Abend
wünscht Jens

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige