49474_sesit-skryt-sloupce.xlsx
Pr.
Sub HideColumns()
Dim R As Long, HD(), DD(), rngHide As Range, rngShow As Range
With Worksheets("Hide")
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 0 Then Exit Sub
HD = .Cells(2, 1).Resize(R, 2).Value
End With
With Worksheets("Data").ListObjects("Tabulka1").HeaderRowRange
DD = .Value
On Error GoTo CHYBA
For R = 1 To UBound(HD, 1)
If HD(R, 2) = "Ano" Then
If rngHide Is Nothing Then Set rngHide = .Columns(Application.Match(HD(R, 1), DD, 0)) Else Set rngHide = Union(rngHide, .Columns(Application.Match(HD(R, 1), DD, 0)))
Else
If rngShow Is Nothing Then Set rngShow = .Columns(Application.Match(HD(R, 1), DD, 0)) Else Set rngShow = Union(rngShow, .Columns(Application.Match(HD(R, 1), DD, 0)))
End If
Next R
End With
If Not rngHide Is Nothing Then rngHide.EntireColumn.Hidden = True
If Not rngShow Is Nothing Then rngShow.EntireColumn.Hidden = False
CHYBA:
If Err.Number <> 0 Then MsgBox "Nastala chyba. Napr. niektoré meno sa nenašlo.", vbCritical
End Sub
Sub HideColumns()
Dim R As Long, HD(), DD(), rngHide As Range, rngShow As Range
With Worksheets("Hide")
R = .Cells(Rows.Count, 1).End(xlUp).Row - 1
If R = 0 Then Exit Sub
HD = .Cells(2, 1).Resize(R, 2).Value
End With
With Worksheets("Data").ListObjects("Tabulka1").HeaderRowRange
DD = .Value
On Error GoTo CHYBA
For R = 1 To UBound(HD, 1)
If HD(R, 2) = "Ano" Then
If rngHide Is Nothing Then Set rngHide = .Columns(Application.Match(HD(R, 1), DD, 0)) Else Set rngHide = Union(rngHide, .Columns(Application.Match(HD(R, 1), DD, 0)))
Else
If rngShow Is Nothing Then Set rngShow = .Columns(Application.Match(HD(R, 1), DD, 0)) Else Set rngShow = Union(rngShow, .Columns(Application.Match(HD(R, 1), DD, 0)))
End If
Next R
End With
If Not rngHide Is Nothing Then rngHide.EntireColumn.Hidden = True
If Not rngShow Is Nothing Then rngShow.EntireColumn.Hidden = False
CHYBA:
If Err.Number <> 0 Then MsgBox "Nastala chyba. Napr. niektoré meno sa nenašlo.", vbCritical
End Sub
Příloha: 
49475_sesit-skryt-sloupce.zip (19kB, staženo 20x)
citovat49475_sesit-skryt-sloupce.zip (19kB, staženo 20x)
RSS nejnovější články