PDA

Vollständige Version anzeigen : VBA Tabellen Dynamisch ausblenden


Plausibel
31.08.2017, 06:24
Hallo zusammen,

ich möchte grundsätzlich über eine Userform eingaben machen und auch neue Tabellenblätter erstellen.
Ein Makro soll dann auch die neuen Tabellenblätter ausblenden


Sub Tabellen_neu_ausblenden()
Application.ScreenUpdating = False
Dim wks As Worksheet



For Each wks In ThisWorkbook.Worksheets

If Not wks.Name = "Auswahl" And Not wks.Name = "Capitän"
And Not wks.Name = "Ersatzspieler" And Not wks.Name = "Aufschläge" And Not wks.Name = Sheets("Vorgaben").Cells(45, 8)
And Not wks.Name = Sheets("Vorgaben").Cells(46, 8)
Then wks.Visible = xlSheetHidden
End If
Next wks

Sheets("Auswahl").Activate = True
Application.ScreenUpdating = True
End Sub

Im Moment schreib ich die Namen der zugefügten Datei in das Worksheet "Vorgaben" und greife wie ihr oben seht darauf zu. Kann ich das auch irgendwie machen dass ich alle zusammen ausblende die in Spalte 8 stehen.
Wollte es mit einer Variablen machen.
Aber wenn ich

Dim i
i=0
und dann
And Not wks.Name = Sheets("Vorgaben").Cells(45 + i, 8)

schreibe dann geht es nach Reihenfolge durch und funktioniert leider auch nicht ganz.

Vielen Dank schon mal im Voraus

Beverly
31.08.2017, 07:43
Hi,

das kannst du z.B. so lösen:

Sub Ausblenden()
Dim lngLetzte As Long
Dim lngZeile As Long
With Worksheets("Vorgaben")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 8)), .Cells(.Rows.Count, 8).End(xlUp).Row, .Rows.Count)
' Schleife von 45. bis letzte belegte Zeile in Spalte H
For lngZeile = 45 To lngLetzte
Worksheets(.Cells(lngZeile, 8).Value).Visible = xlSheetHidden
Next lngZeile
End With
End Sub



Beachte, dass dieser Code auf einen Fehler läuft, wenn ein Tabellenblatt nicht vorhanden ist.


Andere Möglichkeit wäre diese:

Sub Ausblenden2()
Dim rngTab As Range
Dim wksTab As Worksheet
With Worksheets("Vorgaben")
For Each wksTab In Worksheets
Set rngTab = .Columns(8).Find(wksTab.Name, lookat:=xlWhole)
If Not rngTab Is Nothing Then wksTab.Visible = xlSheetHidden
Next wksTab
End With
Set rngTab = Nothing
End Sub


<hr width="20%" align="left"><img src="http://excel-inn.de/images/grusz.gif" height=35" align="left" alt="Grußformel"><a href="http://excel-inn.de/"><img border="0" src="http://excel-inn.de/images/logo1.gif" height=35" align="middle" alt="Beverly's Excel - Inn"></a>

Jonas0806
31.08.2017, 07:53
Hallo,

oder komplett ohne Schleife

arr = Range("H1:H5") 'Deinen Bereich anpassen
Worksheets(Application.Transpose(arr)).Visible = xlSheetHidden

aloys78
31.08.2017, 08:03
Hallo,

und noch eine Variante:
Option Explicit

Sub Tabellen_neu_ausblenden()
Dim wks As Worksheet
Dim Lrow As Long ' Letzte Datenzeile in Sp H von Vorgaben
Dim arr1 As Variant ' Array Tab.Namen in Sp H
Dim arr2 As Variant ' Array sonstige Ausnahmen
Dim erg As Variant
Application.ScreenUpdating = False

' Ausnahmen in arr1 und arr2 speichern
arr2 = Array("Auswahl", "Capitän", "Ersatzspieler", "Aufschläge")
With Worksheets("Vorgaben")
Lrow = .Cells(Rows.Count, "H").End(xlUp).Row
If Lrow >= 45 Then
arr1 = .Range("H45:H" & Lrow)
End If
End With

' alle Blätter, die weder in arr1 noch arr2 benannt werden, sind auzublenden
For Each wks In ThisWorkbook.Worksheets
erg = Application.Match(wks.Name, arr1, 0)
If Not IsNumeric(erg) Then
erg = Application.Match(wks.Name, arr2, 0)
If Not IsNumeric(erg) Then
wks.Visible = xlSheetHidden
End If
End If
Next wks
Sheets("Auswahl").Activate
Application.ScreenUpdating = True
End Sub

Gruß
Aloys

Plausibel
31.08.2017, 15:12
Ihr seid der Hammer =)
Vielen lieben Dank euch allen