Zählenwenn für Hintergrundfarbe, fett, …

Thomas Ramel (langjähriger Microsoft MVP für Excel) hat eine sehr schöne userdefined function vorgestellt, die es ermöglicht Zellen zu zählen, die eine bestimmte Hintergrundfarbe haben, fett markiert sind ….

Nachstehend der von Thomas ausführlich kommentierte QuellcodePublic Function ZählenWennFormat(Bereich As Range, _ ReferenzZelle As Range, _ Optional ZellenFarbe As Boolean = True, _ Optional ZellenMuster As Boolean = False, _ Optional SchriftFarbe As Boolean = False, _ Optional SchriftFett As Boolean = False, _ Optional SchriftKursiv As Boolean = False) _ As Variant '© <script type='text/javascript'> <!-- var prefix = 'ma' + 'il' + 'to'; var path = 'hr' + 'ef' + '='; var addy89748 = 't.ramel' + '@'; addy89748 = addy89748 + 'mvps' + '.' + 'org'; document.write('<a ' + path + '\'' + prefix + ':' + addy89748 + '\'>'); document.write(addy89748); document.write('<\/a>'); //-->\n </script><script type='text/javascript'> <!-- document.write('<span style=\'display: none;\'>'); //--> </script>Diese E-Mail-Adresse ist vor Spambots geschützt! Zur Anzeige muss JavaScript eingeschaltet sein! <script type='text/javascript'> <!-- document.write('</'); document.write('span>'); //--> </script>, 26.08.2009 'Funktion zur Anwendung von ZÄHLENWENN() mit Hintergrund-, 'Schriftfarbe, Fett, Kursiv als Zählkriterium 'Beliebig erweiterbar um weitere Kriterien ' 'Die Parametereingabe erfolgt in derselben Reihenfolge 'wie in der Funktion ZÄHLENWENN(): ' - 1.Parameter BEREICH erwartet den Suchbereich ' - 2.Parameter REFERENZZELLE erwartet einen Zellbezug der als Kriterium ' verwendet wird - die einzelnen Formate werden aus dieser Zelle ermittelt ' - 3.Parameter ZELLENFARBE erwartet Wahr/Falsch für die Hintergrund-Farbe ' - 4.Parameter ZELLENMUSTER erwartet Wahr/Falsch für das Zellenmuster ' - 5.Parameter SCHRIFTFARBE erwartet Wahr/Falsch für die Schrift-Farbe ' - 6.Parameter SCHRIFTFETT Wahr/Falsch für fette Schrift ' - 7.Parameter SCHRIFTKURSIV erwartet Wahr/Falsch für kursive Schrift 'Zur automatischen Aktualisierung im Tabellenblatt den folgenden Term 'anhängen: +(0*JETZT()) und durch F9 drücken die Funktion aktualisieren 'Also z.B. wie folgt: =ZählwenWennFormat(A1:A10;A1)+(0*JETZT()) Dim lngI As Long Dim varWerte As Variant Dim varKrit1 As Variant Dim varKrit2 As Variant Dim Anzahl As Long If Bereich.Rows.Count > 1 And Bereich.Columns.Count > 1 Then ZählenWennFormat = CVErr(xlErrRef) Exit Function End If ReDim varWerte(1 To Bereich.Count) 'Prüfen auf die Farbe der Zelle If ZellenFarbe Then varKrit1 = ReferenzZelle(1).Interior.ColorIndex For lngI = 1 To Bereich.Count If Bereich(lngI).Interior.ColorIndex <> varKrit1 Then varWerte(lngI) = 0 End If Next End If 'Prüfen auf das Muster der Zelle If ZellenMuster Then varKrit1 = ReferenzZelle(1).Interior.Pattern varKrit2 = ReferenzZelle(1).Interior.PatternColorIndex For lngI = 1 To Bereich.Count If (Bereich(lngI).Interior.Pattern <> varKrit1) Or _ (Bereich(lngI).Interior.PatternColorIndex <> varKrit2) Then varWerte(lngI) = 0 End If Next End If 'Prüfen auf die Farbe der Schrift If SchriftFarbe Then varKrit1 = ReferenzZelle(1).Font.ColorIndex For lngI = 1 To Bereich.Count If Bereich(lngI).Font.ColorIndex <> varKrit1 Then varWerte(lngI) = 0 End If Next End If 'Prüfen auf fette Schrift If SchriftFett Then varKrit1 = ReferenzZelle(1).Font.Bold For lngI = 1 To Bereich.Count If Bereich(lngI).Font.Bold <> varKrit1 Then varWerte(lngI) = 0 End If Next End If 'Prüfen auf kursive Schrift If SchriftKursiv Then varKrit1 = ReferenzZelle(1).Font.Italic For lngI = 1 To Bereich.Count If Bereich(lngI).Font.Italic <> varKrit1 Then varWerte(lngI) = 0 End If Next End If ZählenWennFormat = Bereich.Count - WorksheetFunction.Count(varWerte) End Function

 Share on Facebook

Read more http://vba-codeschnipsel.de/zahlenwenn-fur-hintergrundfarbe-fett/