automatické podmíněné skrývání řádků

[rtep007]

Zdravím všechny, mám prosbu ohledně automatického skrývání řádků na základě zobrazené hodnoty v řádku. V několika samostatných tabulkách, které mám řazeny pod sebou bych potřeboval, aby se mi automaticky zobrazovaly pouze řádky "ANO" (viz přiložená tab).Nejedná se o odstranění ale skrývání tak, aby v případě potřeby bylo možno zobrazit i řádky "NE". Jenom chci upozornit, že hodnota "ANO" a "NE" v jednotlivých řádcích je generována pomocí funkce "KDYŽ", tak jenom pro info, aby to nedělalo nějaký problém (v přiložené tab. jsou pouze "čisté" hodnoty "ANO" a "NE"). Je pro to možné řešení? V případě, že ano, lze tato úloha plně automatizovat, a to ve smyslu, když jsou hodnoty "ANO" a "NE" přebírány pomocí funkce, aby se řádky skrývaly okamžitě po zobrazení (zadání) této hodnoty? Myslím tím bez dalších nutných kroků, byť pouze zmáčknutí tlačítka makra, atp.? V podmíněném formátování jsem nic takového nedohledal a klasický filtr bych rád obešel nějakou jinou cestou. Díky moc za každou radu. Pěkný den. Petr

[Reklama]

[guest]

1. Jedině makrem
1a) Ne na základě událostní procedury listu Worksheet_Change (ruční změna obsahu),jedině Worksheet_Calculate (přepočet listu).
1b) Ruční podnět (tlačítko, klávesová zkratka) pro spuštění makra k zobrazení/skrytí.

Mezi námi děvčaty je to možná zbytečné (neviděl jsem ale přílohu). Udělejte z tabulky Tabulku, pokud to jde (Vložení /Tabulka), naučte se s ní dělat a prostě to nebude klepnutí jedno, ale dvě (Filtr sloupce).

[guest]

viz ukázka ve vlastní příloze, zpracováno na tlačítko bez událostí

Kód: Vybrat vše

Sub SkrytRadky()

    Dim rngBunka As Range
   
    Dim i As Integer

    'prirazeni sledovane oblasti do objektove promenne
    Set rngSledovanaOblast = Range("B5:B14,B20:B29")

    'zakaz udalosti a prepoctu listu
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'zobrazeni vsech radku
    rngSledovanaOblast.EntireRow.Hidden = False

    'pro kazdou bunku v oblasti
    For Each rngBunka In rngSledovanaOblast
       
        'obsahuje bunka text "ne"?
        If rngBunka.Text = "ne" Then

            'pridani bunky od oblasti radku ke skryti
            i = i + 1
           
            If i = 1 Then
                Set rngOblastNe = rngBunka
            Else
                Set rngOblastNe = Union(rngOblastNe, rngBunka)
            End If

        End If

    Next rngBunka

    'skryti radku
    rngOblastNe.EntireRow.Hidden = True

    'povoleni prepoctu listu a udalosti
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

[rtep007]

Zdravím všechny a díky za reakci "xlnc". Vaše makro je přesně to, co potřebuji a funguje. Velké díky! Použil jsem ho v kombinaci s již zavedeným makrem, které slouží v mém souboru k řazení dat podle průměru. Také vše funguje ale s malinkou vadou na kráse, protože toto sloučené makro musím aktivovat vždy na dvojí zmáčknutí tak, aby se mi hodnoty seřadily podle průměru a zároveň se mi neaktivní "nulové" řádky skryly. Mohl bych ještě poprosit o revizi tohoto sloučeného makra, kde by mohla být chybička. Bylo by ideální aby sloučené makro bylo aktivní na první zmáčknutí ... Díky předem moc za radu. Přeji pěkný den.
Zdraví PV


Sub SERADIT()
'
' SERADIT Makro
' Seřadí podle výsledného průměru.
'

'

Dim ws As Worksheet

On Error Resume Next

Set ws = ThisWorkbook.ActiveSheet
aplicF
ws.Unprotect "rtep"
With Range("C10:P81")
.Select
End With

With ActiveWorkbook.Worksheets("celkové umístění")
.Sort.SortFields.Clear
.Sort.SortFields.Add(Range( _
"P10:P81"), xlSortOnFontColor, xlDescending, , xlSortNormal).SortOnValue.Color _
= RGB(234, 234, 234)
.Sort.SortFields.Add Key:=Range( _
"P10:P81"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
End With

With ActiveWorkbook.Worksheets("celkové umístění").Sort
.SetRange Range("C10:P81")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

With Range("A1")
.Select
End With


Dim rngBunka As Range

Dim i As Integer

'prirazeni sledovane oblasti do objektove promenne
Set rngSledovanaOblast = Range("d48:d81,ay222:ay257,ay264:ay299,ay306:ay341")

'zakaz udalosti a prepoctu listu
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'zobrazeni vsech radku
rngSledovanaOblast.EntireRow.Hidden = False

'pro kazdou bunku v oblasti
For Each rngBunka In rngSledovanaOblast

'obsahuje bunka text "ne"?
If rngBunka.Text = "" Then

'pridani bunky od oblasti radku ke skryti
i = i + 1

If i = 1 Then
Set rngOblastNe = rngBunka
Else
Set rngOblastNe = Union(rngOblastNe, rngBunka)
End If

End If

Next rngBunka

'skryti radku
rngOblastNe.EntireRow.Hidden = True

'povoleni prepoctu listu a udalosti
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True


ws.Protect "rtep"
aplicT
End Sub

[guest]

Já tu naslepo kód luštit nechci.

[rtep007]

Já jsem luštil a přišel jsem na to, každopádně i tak dík ...