AW: Ausblenden von Tabellenblättern anhand von Filter
05.03.2024 10:39:39
Zahlendreher
Hallo!
Das Problem besteht darin, dass du zwei Schleifen gleichzeitig hast. Durch die Array-Schleife mit LBound-UBound setzt du einmal das Tabellenblatt auf .Visible = True, um es im Anschluss wieder auf .Visible = False zu setzen.
z. B. 8888 und 9999
In der ersten Array-Schleife ist der Wert 8888
If varArr(8888) = Left(8888, 4) Then
ws(8888).Visible = True
UND HIER DAS PROBLEM
Die zweite Array-Schleife hat jetzt den Wert 9999
If varArr(9999) = Left(8888, 4) Then
...
Else
If ws(8888).Visible = True then ws(8888).Visible = False
Deine Variable ws ist immer noch 8888, aber in der Array-Schleife varArr bist du beim Wert 9999, also setzt du 8888 wieder auf Visible = False. Diese beiden Schleifen laufen unabhängig von einander. Erst wenn die innere Array-Schleife fertig ist, springst du in die nächste (äußere) ws-Schleife.
Lösung: Verwende einfach zwei separate Schleifen, dann ist der Code auch gleich schlanker.
Sub TabellenblätterFiltern()
Dim rngRow As Range
Dim ws As Worksheet
Dim wsArr As Worksheet
Dim varArr() As String
Dim intI As Integer
Dim rngBereich As Range
Set rngBereich = ActiveSheet.Range("B6:E14") 'kann natürlich vorher dynamisch deklariert _
werden, z.B. über usedrange, wenn alle Rahmenbedingungen passen.
intI = 0
'Alle sichtbaren Hauptgruppen in Array schreiben
For Each rngRow In rngBereich.Rows
If rngRow.Hidden = False Then
If Not Trim(rngRow.Cells(1, 1) & vbNullString) = vbNullString Then '// Ergänzung, damit keine Leerwerte im Array drin sind
ReDim Preserve varArr(intI)
varArr(intI) = rngRow.Cells(1, 1)
intI = intI + 1
End If
End If
Next
'Alle Tabellenblätter durchlaufen (Schleife 1) und für jedes Tabellenblatt vergleichen, ob _
der linke Buchstabe des TAbellenblatts mit dem des Eintrags im Array übereinstimmt (2. Schleife)
For Each ws In Worksheets
If Not ws.Name = ActiveSheet.Name Then ws.Visible = False
Next ws
For Each ws In Worksheets(varArr)
ws.Visible = True
Next ws
Sheets("Master").Select
End Sub
Aber wesentlich schlanker geht es mit dem Code von Boris und meiner Adaption:
Sub TabellenblätterFiltern()
Dim C As Range
Dim Ws As Worksheet
For Each Ws In Worksheets
If Not Ws.Name = ActiveSheet.Name Then Ws.Visible = False
Next Ws
For Each C In Range("B6:B13").SpecialCells(xlCellTypeVisible)
For Each Ws In ThisWorkbook.Worksheets
If CStr(C) = Left(Ws.Name, 4) Then
Ws.Visible = Not Ws.Visible
End If
Next Ws
Next C
Worksheets("Master").Activate
End Sub
Beste Grüße