263 Aufrufe
Gefragt in Tabellenkalkulation von jelena Mitglied (829 Punkte)
Hallo guten Tag, bitte um ein Excel code die Zeilen 12, 15, 18, 21, 24, 27, 30, 33, 36 und Zeile 39 soll trotz Filter angezeigt werden, wenn sie auch leer sind. Danke

10 Antworten

0 Punkte
Beantwortet von xlking Experte (1.7k Punkte)
Hallo Jelena,

das geht nun wirklich nicht. Wenn ein Filter aktiv ist, kannst du von diesem ausgeblendete Zeilen nicht manuell wieder einblenden. Du kannst dir höchstens merken, welche Zeilen der Filter ausgeblendet hat, den Filter ausschalten und diese Zeilen manuell ausblenden. Wäre das eine Option?

Gruß Mr. K.
0 Punkte
Beantwortet von jelena Mitglied (829 Punkte)
Hallo Mr. K. ich dachte es gäbe eine Möglichkeit, denn sie kennen ja den Spruch geht nicht gibs nicht. Danke
0 Punkte
Beantwortet von xlking Experte (1.7k Punkte)

Wie gesagt, das Einzige was mir hierzu einfällt wäre ein durch einen Button auszuführendes Makro, das den Filter zurücksetzt und die Ausgeblendeten Zeilen selbst ausblendet. Probiere mal diesen Code:

Sub Einblenden()
 'Durch Filter ausgeblendete Zeilen immer einblenden
 
 Dim arr() As Boolean, a As Long, f As Long, i As Long, r As Range
 Dim arr2()
 
 'Zeilen zum einblenden
 arr2 = Array(12, 15, 18, 21, 24, 27, 30, 33, 36, 39)
 
 ReDim arr(ActiveSheet.AutoFilter.Range.Row To ActiveSheet.AutoFilter.Range.Row + ActiveSheet.AutoFilter.Range.Rows.Count - 1) As Boolean
 
 
 a = ActiveSheet.AutoFilter.Range.Row
 
 For Each r In ActiveSheet.AutoFilter.Range.Rows
   If r.Hidden Then arr(r.Row) = True
 Next r
 
 f = ActiveSheet.AutoFilter.Filters.Count
 
 For i = 1 To f
   ActiveSheet.AutoFilter.Range.AutoFilter Field:=i
 Next i
 
 For a = LBound(arr) To UBound(arr)
   ActiveSheet.Rows(a).Hidden = arr(a)
 Next
 
 For a = LBound(arr2) To UBound(arr2)
   Rows(arr2(a)).Hidden = False
 Next a
 
End Sub

Gruß Mr. K.

0 Punkte
Beantwortet von jelena Mitglied (829 Punkte)
Hallo Mr. K. danke das war schon ein guter Ansatz, wie kann ich das wieder rückgängig machen, denn damit könnte ich auskommen.
0 Punkte
Beantwortet von xlking Experte (1.7k Punkte)
Einfach nach etwas anderem filtern oder zumindest irgendeinen Filter mal anklicken und OK drücken.

Gruß Mr. K.
0 Punkte
Beantwortet von xlking Experte (1.7k Punkte)

Ich stelle grade fest, es geht doch noch einfacher. Man muss nur vorher Hidden auf True setzen, dann kann man es auch wieder auf False setzen. Ich nehme somit meine erste Aussage, es ginge nicht, zurück.

Sub Einblenden()

Dim arr2(), i As Long

arr2 = Array(12, 15, 18, 21, 24, 27, 30, 33, 36, 39)

For i = 0 To UBound(arr2)
  Rows(arr2(i)).Hidden = True
  Rows(arr2(i)).Hidden = False
Next i

End Sub

Gruß Mr. K.

0 Punkte
Beantwortet von xlking Experte (1.7k Punkte)

Leider muss das Makro oben immer noch manuell über Button angestoßen werden, da es kein Ereignis gibt, das auf Filtern reagiert. Moment mal: Gibt es wirklich kein Ereignis? Doch eines gibt es. Und zwar das Application.AfterCalculate-Ereignis. Damit kannst du die Zeilen direkt beim Filtern wieder einblenden. Allerdings springt es auch bei jeder anderen Aktion an, wo eine Berechnung erfolgt. Deshalb ist es mit Vorsicht zu genießen. Probier es aber trotzdem mal aus.

In ein neues Klassenmodul namens Klasse1 kommt dieser Code:

Public WithEvents app As Application

Private Sub app_AfterCalculate()
  
Dim arr2(), i As Long, flton As Boolean

If ActiveSheet.Name = "Tabelle1" And ActiveWorkbook.Name = ThisWorkbook.Name Then
  For Each f In ActiveSheet.AutoFilter.Filters
    If f.On Then flton = True
  Next f
  If flton Then
    Application.EnableEvents = False
    arr2 = Array(12, 15, 18, 21, 24, 27, 30, 33, 36, 39)
    For i = 0 To UBound(arr2)
      Rows(arr2(i)).Hidden = True
      Rows(arr2(i)).Hidden = False
    Next i
    Application.EnableEvents = True
  End If
End If
  
End Sub

Dann noch in das Modul "Diese Arbeitsmappe dieser Code"

Dim xl As New Klasse1
Private Sub Workbook_Open()
  Set xl.app = Application
End Sub

Solltest du in "DieseArbeismappe" schon Code stehen haben, kommt muss der neue davor eingefügt werden.

Nach dem Schließen und wieder öffnen der Datei sollte es funktionieren. Den Tabellennamen "Tabelle1" musst du natürlich noch anpassen.

Gruß Mr. K.

0 Punkte
Beantwortet von jelena Mitglied (829 Punkte)

Hallo Mr. K. ich habe alles laut beschreibung ausgeführt trotzdem kommt beim öffnen der Datei diese Fehlermeldung, es ist eine .xlsm Datei. Danke

Private Sub Workbook_Open()
  Set xl.app = Application
End Sub

0 Punkte
Beantwortet von xlking Experte (1.7k Punkte)

Hast du vor Workbook_Open wie in meinem Code gezeigt diese Zeile stehen? Die ist wichtig!

Dim xl As New Klasse1

Mr. K.

0 Punkte
Beantwortet von jelena Mitglied (829 Punkte)
Hallo Mr. K. es hat geklappt. Danke
...