AW: danke!
26.05.2014 18:55:33
Ewald
Hallo Georg,
in der Liste wird ja auch jede Zelle aufgelistet,während im Manager ja nur die einzelnen Formatierungen stehen,egal wieviel Zellen sie umfaasen.
habe jetzt mal erweitert, in Spalte L wird der Gültigskeitsbereich ausgegeben und danach wird die Spalte auf Doppelte gefiltert.
Schau mal ob das paßt
Sub BedForliste()
Dim rngcell As Range
Dim i As Long
Dim k As Long
Dim FCA As String
Dim FCT As Long
Dim FCN As String
Dim FCP As Long
Dim FCF As String
Dim FCC As Long
Dim FCFC As Long
Dim FCDBC As Long 'Datenbalkenfarbe
Dim FCSC1 As Long 'Farbscala 1.Farbe
Dim FCSC2 As Long 'Farbscala 2.Farbe
Dim FCSC3 As Long 'Farbscala 3.Farbe
Dim Bereich As String
k = 80
For Each rngcell In ActiveSheet.UsedRange
For i = 1 To rngcell.FormatConditions.Count
On Error Resume Next
FCA = rngcell.Address(0, 0)
FCP = i
FCT = rngcell.FormatConditions(i).Type
Bereich = rngcell.FormatConditions(i).AppliesTo.Address(0, 0)
If FCT = 3 Or FCT = 4 Or FCT = 6 Then
FCC = xlNone
FCF = ""
If FCT = 4 Then
FCDBC = rngcell.FormatConditions(i).BarColor.Color
End If
If FCT = 3 Then
FCSC1 = rngcell.FormatConditions(i).ColorScaleCriteria(1).FormatColor.Color
FCSC2 = rngcell.FormatConditions(i).ColorScaleCriteria(2).FormatColor.Color
FCSC3 = rngcell.FormatConditions(i).ColorScaleCriteria(3).FormatColor.Color
End If
Else
FCC = rngcell.FormatConditions(i).Interior.Color
FCFC = rngcell.FormatConditions(i).Font.Color
FCF = "!" & rngcell.FormatConditions(i).Formula1
End If
Select Case FCT
Case 1
FCN = "Zellenwert"
Case 2
FCN = "Formel"
Case 3
FCN = "Farbscala"
Case 4
FCN = "Datenbalken"
Case 5
FCN = "Top"
Case 6
FCN = "Symbolsatz"
Case 8
FCN = "Einzel/Doppel"
Case 9
FCN = "Text"
Case 10
FCN = "Leer"
Case 11
FCN = "Datum"
Case 12
FCN = "Durchschnitt"
Case 13
FCN = "ohne Leerzeichen"
Case 14
FCN = "Nicht Leer"
Case 16
FCN = "Fehler"
Case 17
FCN = "Nicht Fehler"
End Select
Cells(k, 1) = FCA
Cells(k, 2) = FCP
Cells(k, 3) = FCT
Cells(k, 4) = FCN
Cells(k, 5) = FCC
Cells(k, 5).Interior.Color = FCC
Cells(k, 6) = FCFC
Cells(k, 6).Font.Color = FCFC
Cells(k, 7) = FCDBC
Cells(k, 7).Interior.Color = FCDBC
Cells(k, 8) = FCSC1
Cells(k, 8).Interior.Color = FCSC1
Cells(k, 9) = FCSC2
Cells(k, 9).Interior.Color = FCSC2
Cells(k, 10) = FCSC3
Cells(k, 10).Interior.Color = FCSC3
Cells(k, 11) = FCF
Cells(k, 12) = Bereich
k = k + 1
FCA = ""
FCT = 0
FCN = ""
FCP = 0
FCF = ""
FCC = 0
FCFC = 0
FCDBC = -4142
FCSC1 = -4142
FCSC2 = -4142
FCSC3 = -4142
Next
Next
Columns("L:L").Select
Selection.AutoFilter
Selection.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
End Sub
Gruß Ewald