title image


Smiley Autofilter Übersichtlich: markierte Übersicht und Kommentaranzeige
Hallo Boris,



vielen Dank für den Tip, das war der fehlende Baustein. Das ist draus geworden, ggf kannst du es ja mal gebrauchen:







      

Sub AutofilterKennzeichnen()

'gefilterte Spaltenüberschriften werden blau gekennzeichnet, zusätzlich wird in der

' oberen linken Ecke noch ein Kommentar mit allen Filterungen angelegt (Achtung, ggf. vorhandener Kommentar wird gelöscht)

'G. Hoffmann August 2004

Dim s As Integer

Dim Krit1 As String, Krit2 As String, Oper As String, Filterungen As String

    If ActiveSheet.AutoFilterMode = True Then 'wenn es einen Filtermodus gibt

        ' ggf alten Kommentar löschen i.d. oberen linken Ecke

        Cells(ActiveSheet.AutoFilter.Range.Row, ActiveSheet.AutoFilter.Range.Column).ClearComments

        On Error Resume Next

        For s = 1 To ActiveSheet.AutoFilter.Filters.Count 'Anzahl der Filter

            'ggf. alte Farbmarkierung zurücksetzen

            Cells(ActiveSheet.AutoFilter.Range.Row, s).Interior.ColorIndex = xlNone

            On Error Resume Next

            If ActiveSheet.AutoFilter.Filters(s).On Then 'Wenn Spalte gefiltert dann...

                Cells(ActiveSheet.AutoFilter.Range.Row, s).Interior.ColorIndex = 17 'Überschrift blau

                With ActiveSheet.AutoFilter.Filters(s) 'Filterkriterien auslesen

                    Krit1 = .Criteria1

                    Krit2 = .Criteria2

                    Oper = .Operator

                End With

                If Oper = 2 Then 'Operatorzeichen in lesbaren Text umwandeln

                    Oper = " oder "

                    Else:

                    Oper = " und "

                End If

                If Krit2 <> "" Then 'Text erstellen aus: Überschrift, Zelladresse und Filterungen

                    Filterungen = Filterungen & Cells(ActiveSheet.AutoFilter.Range.Row, s).Value _

                    & " (" & Cells(ActiveSheet.AutoFilter.Range.Row, s).Address _

                    & ") gefiltert nach: " & Krit1 & Oper & Krit2 & Chr(10)

                    Else

                    Filterungen = Filterungen & Cells(ActiveSheet.AutoFilter.Range.Row, s).Value _

                    & " (" & Cells(ActiveSheet.AutoFilter.Range.Row, s).Address(RowAbsolute:=False, columnAbsolute:=False) _

                    & ") gefiltert nach: " & Krit1 & Chr(10)

                End If

            End If

        Next

    End If

    

    If Filterungen <> "" Then

        With Cells(ActiveSheet.AutoFilter.Range.Row, ActiveSheet.AutoFilter.Range.Column)

            .AddComment 'Kommentar einfügen

            .Comment.Text Text:="Filterungen in der Tabelle:" & Chr(10) & Filterungen 'Text

            .Comment.Shape.TextFrame.AutoSize = True ' Größe anpassen

        End With

    End If

End Sub 





Code eingefügt mit Syntaxhighlighter 3.0







liebe grüsse georg
Beiträge zu Excel 2002 in Verbindung mit Win XP

 A
1Tabellentool
2von StrgAltEntf


Gibts hier


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: