S komentářem. Zachatává se řídící buňka a základě její hodnoty se mění viditelnost odpovídajících řádků
' Předpokládám, že řídící buňka je B1
' a seznam listů je v buňkách L1:L100 (v listu Vzorce)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [B1]) Is Nothing Then ' Průnik dvou oblastí existuje (změněná buňka a B1)
Call Skryj ' Změnila se hodnota
ElseIf Not Intersect(Target, [L1:L100]) Is Nothing Then
Call Skryj ' Přidán další list
End If
On Error GoTo 0
End Sub
Sub Skryj()
Dim rngJmenoListu As Range
Dim oWS As Worksheet
On Error GoTo DalsiList:
For Each rngJmenoListu In [L1:L100] ' Pro všechny hodnoty v oblasti L1:L100
Set oWS = Worksheets(rngJmenoListu.Text) ' Zkus vybrat list
With oWS ' Pokud list existuje
.Rows("1:3").Hidden = True ' Zobraz dříve skryté řádky
Select Case [B1] ' Podle stavu řídící buňky B1 skryj příslušné řádky
Case 1: .Rows("1:1").Hidden = False ' B1 = 1
Case 2: .Rows("1:2").Hidden = False ' B1 = 2
Case 3: .Rows("1:3").Hidden = False ' B1 = 3
End Select
End With
DalsiList:
Next ' Pokračuj s dalším listem
On Error GoTo 0
End Sub
citovat
' Předpokládám, že řídící buňka je B1
' a seznam listů je v buňkách L1:L100 (v listu Vzorce)
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [B1]) Is Nothing Then ' Průnik dvou oblastí existuje (změněná buňka a B1)
Call Skryj ' Změnila se hodnota
ElseIf Not Intersect(Target, [L1:L100]) Is Nothing Then
Call Skryj ' Přidán další list
End If
On Error GoTo 0
End Sub
Sub Skryj()
Dim rngJmenoListu As Range
Dim oWS As Worksheet
On Error GoTo DalsiList:
For Each rngJmenoListu In [L1:L100] ' Pro všechny hodnoty v oblasti L1:L100
Set oWS = Worksheets(rngJmenoListu.Text) ' Zkus vybrat list
With oWS ' Pokud list existuje
.Rows("1:3").Hidden = True ' Zobraz dříve skryté řádky
Select Case [B1] ' Podle stavu řídící buňky B1 skryj příslušné řádky
Case 1: .Rows("1:1").Hidden = False ' B1 = 1
Case 2: .Rows("1:2").Hidden = False ' B1 = 2
Case 3: .Rows("1:3").Hidden = False ' B1 = 3
End Select
End With
DalsiList:
Next ' Pokračuj s dalším listem
On Error GoTo 0
End Sub
citovat
RSS nejnovější články