Ausgeblendete Zeilen in Berechnung einbeziehen

Question

Hallo,
ich bin bisher davon ausgegangen, daß ausgeblendete Zeilen beim Ausführen einer Schleife trotzdem mit "bearbeitet"/berücksichtigt werden. Jetzt stelle ich fest, daß ich unterschiedliche Ergebnisse in Abhängigkeit davon erhalte, ob bestimmte Zeilen innerhalb der Schleife ein- oder ausgeblendet sind. Kann mir jemand sagen, wie hier die grundsätzliche Regel lautet? Danke und Gruß.
A.

Answer 1

Hallo Community .-)

Ein Beispiel!

Gruß Nighty

Gesetzter Autofilter Bedingung
Allr Crit angaben eines Bereiches werden ausgelesen und neu gesetzt!

Sub Autofilter_Crit_Maker()
Dim FilteredRange As Object
Dim Zelle As Integer
Set FilteredRange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
ReDim AFdaten(FilteredRange.Columns.Count) As Variant
For Zelle = FilteredRange.Column To FilteredRange.Column + FilteredRange.Columns.Count - 1
AFdaten(Zelle - FilteredRange.Column + 1) = AF_KRIT(Cells(1, Zelle))
Next Zelle
ActiveSheet.Cells(1, FilteredRange.Column).AutoFilter
'Deine Berechnungen Ohne Autofilter
'Restaurierung des Autofilters folgt
ActiveSheet.Range(Cells(1, FilteredRange.Column), Cells(1, FilteredRange.Column + FilteredRange.Columns.Count - 1)).AutoFilter
For Zelle = 1 To UBound(AFdaten)
If AFdaten(Zelle) <> "" Then ActiveSheet.Cells(1, FilteredRange.Column - 1 + Zelle).AutoFilter Field:=Zelle, Criteria1:=AFdaten(Zelle)
Next Zelle
End Sub

Public Function AF_KRIT(Bereich As Range) As String
Dim s_Filter As String
s_Filter = ""
On Error GoTo Ende
With Bereich.Parent.AutoFilter
With .Filters(Bereich.Column - .Range.Column + 1)
s_Filter = .Criteria1
Select Case .Operator
Case xlAnd
s_Filter = s_Filter & " UND " & .Criteria2
Case xlOr
s_Filter = s_Filter & " ODER " & .Criteria2
End Select
End With
End With
Ende:
AF_KRIT = s_Filter
End Function

Answer 2

Hallo Community ^^

Die Function Function AF_KRIT (eines anderen netten Members) fand ich recht nett!

Gruss Nighty

Answer 3

Hallo Andreas,

ich habe dich nicht vergessen. Ich konnte am Freitag das Makro in Excel 2010 testen. Mit Anpassung von Antwort 10 funktioniert das schon ganz gut. Ein Problem bereiteten aber gefilterte Datumswerte, sowie gefilterte Farben. An dieser Stelle hat leider auch Nightys Variante versagt. Das liegt aber nicht an unseren Codes sondern an einem von Microsoft verursachten Bug, der sich bereits im inkorrekten Auslesen der Criteria1 Eigenschaft befindet. für diese beiden Spezialfälle habe ich meinen Code nochmal angepasst und eben erfolgreich getestet.

Sub FilterwerteDurchsuchen()

Dim Filtersaver() As Variant 'hier werden die Filtereinstellungen gespeichert

Set Blatt = Worksheets("Tabelle1")

On Error GoTo Errorhandler

With Blatt.AutoFilter
'Filter zurücksetzen und Werte speichern With Blatt.AutoFilter
ReDim Filtersaver(.Filters.Count, 3) 'array auf Filtergröße ausweiten

For i = 1 To .Filters.Count 'Anzahl der filterbaren Spalten
If .Filters(i).On Then 'wenn Filter aktiv
Filtersaver(i, 1) = .Filters(i).Criteria1 'Bedingung1 oder Multiauswahl speichern
If Not IsArray(Filtersaver(i, 1)) And .Filters(i).Operator > 0 Then 'Wenn Operator vorh.
Filtersaver(i, 2) = .Filters(i).Criteria2 'Kriterium2 speichern
End If
If .Filters(i).Operator > 0 Then 'Wenn Operator vorh.
If .Filters(i).Operator >= 3 And .Filters(i).Operator <= 6 Then
Filtersaver(i, 3) = xlAnd 'Operator speichern
Else
Filtersaver(i, 3) = .Filters(i).Operator 'Operator speichern
End If
End If
.Range.AutoFilter Field:=i 'Filter wird auf "Alle" gesetzt
End If
Next i
End With
On Error GoTo 0

Stop '(Haltepunkt zum Testen das ' vorübergehend entfernen)

'---------------------
'HIER BEGINNT DEIN MAKRO
'---------------------
'
'...
'Set rng1 = LAGB.Columns(8).Find(what:=Cells(i, 5), lookat:=xlWhole) '...
'
'---------------------
'HIER ENDET DEIN MAKRO
'---------------------


'Filter wieder gemäß den gespeicherten Werten neu setzen With Blatt.AutoFilter
With Blatt.AutoFilter
For i = 1 To .Filters.Count 'Anzahl der filterbaren Spalten
If Not IsEmpty(Filtersaver(i, 1)) Then 'Wenn mindestens eine Bedingung gespeichert wurde
a = Filtersaver(i, 1)
b = Filtersaver(i, 3)
.Range.AutoFilter Field:=i, Criteria1:=Filtersaver(i, 1), _
Criteria2:=IIf(IsEmpty(Filtersaver(i, 2)), Null, Filtersaver(i, 2)), _
Operator:=IIf(IsEmpty(Filtersaver(i, 3)), Null, Filtersaver(i, 3))
End If
Next i
End With

ReDim Filtersaver(0) 'Löschen der gespeicherten Filterwerte

Exit Sub

Errorhandler:
With Blatt.AutoFilter
Select Case .Filters(i).Operator
Case 7 'xlFilterValues
ReDim varr(.Range.Columns(i).SpecialCells(xlVisible).Count - 2) As String
For Each c In .Range.Columns(i).SpecialCells(xlVisible)
If k > 0 Then varr(k - 1) = c.Text
k = k + 1
Next c
Filtersaver(i, 1) = varr
Case 8 'xlColors
For Each c In .Range.Columns(i).SpecialCells(xlVisible)
If c.Row > .Range.Row Then
Filtersaver(i, 1) = c.Interior.Color
Exit For
End If
Next c
Case 9 'xlFilterFontColor
For Each c In .Range.Columns(i).SpecialCells(xlVisible)
If c.Row > .Range.Row Then
Filtersaver(i, 1) = c.Font.Color
Exit For
End If
Next c
End Select
End With
Resume Next

End Sub

Gruß Mr. K.

Answer 4

Eine Besonderheit gibt noch die Hintergrundfarbe "Keine Füllung"
Ersetze hierfür den Block

With Blatt.AutoFilter
For i = 1 To .Filters.Count 'Anzahl der filterbaren Spalten
If Not IsEmpty(Filtersaver(i, 1)) Then 'Wenn mindestens eine Bedingung gespeichert wurde
a = Filtersaver(i, 1)
b = Filtersaver(i, 3)
.Range.AutoFilter Field:=i, Criteria1:=Filtersaver(i, 1), _
Criteria2:=IIf(IsEmpty(Filtersaver(i, 2)), Null, Filtersaver(i, 2)), _
Operator:=IIf(IsEmpty(Filtersaver(i, 3)), Null, Filtersaver(i, 3))
End If
Next i
End With

durch

With Blatt.AutoFilter
For i = 1 To .Filters.Count 'Anzahl der filterbaren Spalten
.Range.AutoFilter Field:=i, Criteria1:=IIf(IsEmpty(Filtersaver(i, 1)), Null, Filtersaver(i, 1)), _
Criteria2:=IIf(IsEmpty(Filtersaver(i, 2)), Null, Filtersaver(i, 2)), _
Operator:=IIf(IsEmpty(Filtersaver(i, 3)), Null, Filtersaver(i, 3))
Next i
End With

Answer 5

Hallo Mr. K.

Wie gewünscht!

Die Funktion liefert dir den voreingestellten Farbnamen
Nutze eine Hilfsspalte fuer die Funktion
Nun kannst du nach den Farbnamen Filtern :-)

Gruss Nighty

Function Farbnamen(Zelle As Range) As String
FarbIndex = Array("Schwarz", "Weiß", "Rot", "Hellgrün", "Blau", "Gelb", "Rosa", "Türkis", "Dunkelrot", "Grün", _
"Dunkelblau", "Dunkelgelb", "Violett", "Seegrün", "Grau", "Grau", "Immergrün", "Pflaume", "Elfenbein", "helles Türkis", _
"Dunkelpurpur", "Koralle", "Meeresblau", "Eisblau", "Dunkelblau", "Rosa", "Gelb", "Türkis", "Violett", "Dunkelrot", _
"Seegrün", "Blau", "Himmelblau", "helles Türkis", "Pastellgrün", "Hellgelb", "Blaßblau", "Hellrosa", "Lavendel", _
"Gelbbraun", "Hellblau", "Aquablau", "Gelbgrün", "Gold", "helles Orange", "Orange", "Blaugrau", "Grau 40", "Grünblau", _
"Meeresgrün", "Dunkelgrün", "Olivgrün", "Braun", "Pflaume", "Indigoblau", "Grau 80")
If Zelle.Interior.ColorIndex > -1 Then
Farbnamen = FarbIndex(Zelle.Interior.ColorIndex - 1)
Else
Farbnamen = ""
End If
End Function