ZählenWennFormat
Downloads
Das Problem
Excel bietet keine Funktion um Zellen zu zählen welche gleich formatiert sind.
Die Lösung
Über eine selbst definierte Funktion kann Excel einen Zellbereich auf gleich formatierte Zellen prüfen.
Dabei bietet sich das Konstrukt einer Vergleichszelle an. Andernfalls würde die Vergleichsoperation sehr unhandlich werden.
mit Einschränkungen...
Das Problem an diesem Vergleich ist, dass Excel selbst das Arbeitsblatt nicht neu berechnet wenn die Formatierung geändert wird. Dies bedeutet, dass das Ergebnis der Funktion nach reiner Formatänderung falsch sein kann.
Abhilfe schafft ein Trick in der Ergebniszelle indem man zum Ergebnis 0 mal das heutige Datum addiert (=ZählenWennFormat(A2:C6;D3)+0*HEUTE()
) und nach Änderung die Neuberechnung mit F9
erzwingt.
Quellcode ›ZaehlenWennFormat.bas‹
Attribute VB_Name = "myFunctions"
Option Explicit
Public Function ZählenWennFormat(Bereich As Range, Referenzzelle As Range, Optional nurHintergrund As Boolean) As Long
'Bsp.: =ZählenWennFormat(A2:C6;D3)
'BSp.: =ZählenWennFormat(A2:C6;D3,1) wenn nur der Hintergrund berücksichtigt werden soll
'PROBLEM: EXCEL berechnet nicht neu, wenn das Format geändert wurde
'-> Abhilfe '=ZählenWennFormat(A2:C6;D3)+0*HEUTE()' und anschließend mit 'F9' das Arbeitsblatt neu berechnen
'zählt die Anzahl der Zellen innerhalb von A2:C6 welche das Format von D3 besitzen
'Format berücksichtigt den Hintergrund der Zelle (Farbe, Muster und Musterfarbe)
'und den Vordergrund (Schiftfarbe, Fettschrift, Kursivschrift, Unterstreichung, Schriftname und Schriftgröße)
'soll nur der Hintergrund berücksichtigt werden, muss als dritter Parameter WAHR / TRUE / 1 übergeben werden
Dim i, j As Long
Dim myCellColorIndex, myCellColor, myPatternColorIndex, myPattern, myPatternColor As Variant
Dim myFontColor, myFontBold, myFontUnderline, myFontName, myFontSize As Variant
Dim myFontItalic As Boolean
myCellColorIndex = Referenzzelle.Interior.ColorIndex
myCellColor = Referenzzelle.Interior.Color
myPattern = Referenzzelle.Interior.Pattern
myPatternColorIndex = Referenzzelle.Interior.PatternColorIndex
myPatternColor = Referenzzelle.Interior.PatternColor
myFontColor = Referenzzelle.Font.ColorIndex
myFontBold = Referenzzelle.Font.Bold
myFontItalic = Referenzzelle.Font.Italic
myFontUnderline = Referenzzelle.Font.Underline
myFontName = Referenzzelle.Font.Name
myFontSize = Referenzzelle.Font.Size
ZählenWennFormat = 0
For i = 1 To Bereich.Rows.Count
For j = 1 To Bereich.Columns.Count
'Hintergrundfarbe
If (Bereich(i, j).Interior.ColorIndex = myCellColorIndex) And (Bereich(i, j).Interior.Color = myCellColor) Then
'Hintergrundmuster
If (Bereich(i, j).Interior.Pattern = myPattern) And (Bereich(i, j).Interior.PatternColor = myPatternColor) And (Bereich(i, j).Interior.PatternColorIndex = myPatternColorIndex) Then
If Not nurHintergrund Then
'Schriftbild
If (Bereich(i, j).Font.ColorIndex = myFontColor) And (Bereich(i, j).Font.Bold = myFontBold) And (Bereich(i, j).Font.Italic = myFontItalic) And (Bereich(i, j).Font.Underline = myFontUnderline) And (Bereich(i, j).Font.Name = myFontName) And (Bereich(i, j).Font.Size = myFontSize) Then
ZählenWennFormat = ZählenWennFormat + 1
End If
Else
ZählenWennFormat = ZählenWennFormat + 1
End If
End If
End If
Next
Next
End Function
07.01.2016 16:42