< návrat zpět

MS Excel


Téma: Makro na skrytí sloupců v závislosti na název rss

Zaslal/a 15.1.2021 10:50

Dobrý den, rád bych požádal o radu, zda je možné udělat makro, které by skrylo některé sloupce na listě Data.
Seznam sloupců je v druhém listě Hide
Sloupce, které se mají skrýt jsou označeny jako "Ano"

Celkový soubor, který používám má asi přes 100 sloupců a skrývání po jednotlivých sloupcích je poměrně dost náročné a nepřehledné...

Pomohl by mi s tím někdo?

Děkuji

Příloha: xlsx49474_sesit-skryt-sloupce.xlsx (12kB, staženo 7x)
Zaslat odpověď >

#049475
elninoslov
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
Příloha: zip49475_sesit-skryt-sloupce.zip (19kB, staženo 6x)
citovat
#049477
avatar
Super, děkuji moc. To byla rychlost....

Funguje to naprosto správně.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura III

Oblíbený formulář Faktura byl vylepšen a rozšířen. Formulář faktura III
Více se dočtete zde.

Aktivní diskuse

Seznam hodnot

elninoslov • 3.3. 15:25

Automat.vyplnění formuláře daty z Excelu

mullekri • 3.3. 14:23

Automat.vyplnění formuláře daty z Excelu

Rejpal • 3.3. 13:47

Automat.vyplnění formuláře daty z Excelu

mullekri • 3.3. 13:12

Automat.vyplnění formuláře daty z Excelu

mullekri • 3.3. 13:09

Automat.vyplnění formuláře daty z Excelu

mullekri • 3.3. 13:08

Seznam hodnot

pavelo • 3.3. 11:43