AW: Farben zählen bei bedingter Formatierung
05.01.2006 08: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