Farben zählen bei bedingter Formatierung

Forumthread: Farben zählen bei bedingter Formatierung

05.01.2006 07:05:43

Erich

Hallo EXCEL-Freunde,
aus dem Forum habe ich nachstehende Codes, mit denen man Zellen zählen kann,
die einen farblichen Hintergrund haben. Wenn der farbliche Hintergrund aller-
dings durch eine bedingte Formatierung zustande kommt, gehts nicht.
Gibts für eine Farbenzählung mit bedingter Formatierung vielleicht auch ein Lösung?
Option Explicit
' von Melanie Breden und Thomas Ramel
' Anzahl der Zellen mit einer Farbe
Function CountColor(Farbe As Range, ParamArray rngArea()) As Double
Dim rngCell As Range
Dim varArea As Variant
Dim intColor As Integer
intColor = Farbe(1).Interior.ColorIndex
Application.Volatile
For Each varArea In rngArea
For Each rngCell In varArea
If rngCell.Interior.ColorIndex = intColor Then
CountColor = CountColor + 1
End If
Next
Next
End Function
'Im Tabellenblatt dann einfach den folgenden Aufruf:
'=CountColor(A1;$C$1:$C$12)
' Melanie Breden
'Hast du getrennte Bereiche, führe sie durch Simikolons getrennt auf:
'=CountColor(3;A1:A10;C1:C10)
' Anzahl der Zellen mit einer Farbe
' In Zelle=Farbsumme(A1:A10;3)
Function FarbsummeHA(Bereich As Range, Farbe As Integer)
' Hintergrund
Dim Zelle
Application.Volatile
For Each Zelle In Bereich
If Zelle.Interior.ColorIndex = Farbe Then
FarbsummeHA = FarbsummeHA + 1
End If
Next
End Function

Besten Dank für eine Hilfe!
mfg
Erich
EXCEL-Shareware und Freeware: http://www.toolex.de
Private Tippgemeinschaft für Lotto oder KENO: http://www.kenostrategen.de

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Farben zählen bei bedingter Formatierung

05.01.2006 07:59:01

Harald

AW: Farben zählen bei bedingter Formatierung

05.01.2006 07:59:01

Harald

Hallo Erich,
ich habe mal folgenden Code in einem Forum gefunden und nicht weiter getestet.
Sub MachWas() Dim Zelle As Range: Zeile = 1 For Each Zelle In Worksheets("Tabelle1").UsedRange If Zelle.Interior.ColorIndex = 3 Then Worksheets("Tabelle1").Rows(Zelle.Row).Copy Destination:=Worksheets("Tabelle2").Range("A" & Zeile) Zeile = Zeile + 1 ' Format, Muster Zellen ElseIf Cells(Zelle.Row, Zelle.Column).FormatConditions.Parent.Interior.ColorIndex = 3 Then Worksheets("Tabelle1").Rows(Zelle.Row).Copy Destination:=Worksheets("Tabelle2").Range("A" & Zeile) Zeile = Zeile + 1 ' bedingte Formatierung erkennen ' noch fehlerhaft es werden alle Zellen kopiert die bei bedingte Formatierung den Hintergrund rot(3) ' färben sollen auch wenn nicht erfüllt ElseIf Cells(Zelle.Row, Zelle.Column).FormatConditions.Item(1).Interior.ColorIndex = 3 Then Worksheets("Tabelle1").Rows(Zelle.Row).Copy Destination:=Worksheets("Tabelle2").Range("A" & Zeile) Zeile = Zeile + 1 End If Next Zelle End Sub


Sub test()
'   von JensF
Dim OP As Long
Dim Formel As Long
Dim Farbe As Long
Dim Z As Range
Dim Erfüllt As Boolean
Set Z = ActiveCell
Formel = Z.FormatConditions(1).Formula1
OP = Z.FormatConditions(1).Operator
Select Case OP
Case xlGreater
Erfüllt = (Z.Value > Formel)
Case xlGreaterEqual
Erfüllt = (Z.Value >= Formel)
Case xlLessEqual
Erfüllt = (Z.Value <= Formel)
Case xlLess
Erfüllt = (Z.Value < Formel)
End Select
If Erfüllt Then
MsgBox Z.FormatConditions.Item(1).Interior.ColorIndex
Else
MsgBox Z.Font.ColorIndex
End If
End Sub


Sub MachWas2()
Dim Zelle As Range
Dim Formel As Long
Dim Z As Range
Dim Erfüllt As Boolean
Zeile = 1
For Each Zelle In Worksheets("Tabelle1").UsedRange
If Zelle.Interior.ColorIndex = 3 Then
Worksheets("Tabelle1").Rows(Zelle.Row).Copy Destination:=Worksheets("Tabelle2").Range("A" & Zeile)
Zeile = Zeile + 1
'       Format, Muster Zellen
ElseIf Cells(Zelle.Row, Zelle.Column).FormatConditions.Parent.Interior.ColorIndex = 3 Then
Worksheets("Tabelle1").Rows(Zelle.Row).Copy Destination:=Worksheets("Tabelle2").Range("A" & Zeile)
Zeile = Zeile + 1
'       bedingte Formatierung erkennen
'       noch fehlerhaft es werden alle Zellen kopiert die bei bedingte Formatierung den Hintergrund rot(3)
'       färben sollen auch wenn nicht erfüllt
ElseIf Cells(Zelle.Row, Zelle.Column).FormatConditions.Item(1).Interior.ColorIndex = 3 Then
Set Z = Cells(Zelle.Row, Zelle.Column)
Formel = Z.FormatConditions(1).Formula1
OP = Z.FormatConditions(1).Operator
Select Case OP
Case xlGreater
Erfüllt = (Z.Value > Formel)
Case xlGreaterEqual
Erfüllt = (Z.Value >= Formel)
Case xlLessEqual
Erfüllt = (Z.Value <= Formel)
Case xlLess
Erfüllt = (Z.Value < Formel)
End Select
If Erfüllt Then
Worksheets("Tabelle1").Rows(Zelle.Row).Copy Destination:=Worksheets("Tabelle2").Range("A" & Zeile)
Zeile = Zeile + 1
End If
End If
Next Zelle
End Sub

Gruss Harald

Beliebteste Forumthreads (12 Monate)

Farben zählen bei bedingter Formatierung

Forumthread: Farben zählen bei bedingter Formatierung

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread