VBA worksheet change pro víc buňek

[Andrea320]

Dobrý den,

prosím o radu - na jednom listu v excelu mám několik buněk, ve kterých je vždy rozevírací seznam s možností volby YES/NO. Potřebovala bych, aby u každé buňky, když se zvolí možnost YES tak se určité řádky zobrazily a když vyberu možnost NO tak se ty stejné řádky schovají. Zobrazování/skrývání řádků mám napsáno ve zvlášť makrech, takže stačí to makro zavolat.
Mám napsané tohle, které mi funguje pro jednu buňku. Potřebuju to ale rozšířit na další buňky (např. při změně v buňce D39 na YES spusť makro 4 (zobrazit řádky) a jinak makro 3 (skrýt řádky). Nevím vůbec jak to do toho kódu dostat :-/ Případně i pokud by byla možnost na jednom listu použít funkci worksheet change víc krát (s podtržítkem a pod), tak by mi to taky pomohlo.
Moc děkuji za jakoukoliv radu.
Andrea

Private Sub worksheet_change(ByVal target As Range)

If Range("D4").Value = "YES" Then
Application.EnableEvents = False
Call Makro2
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call Makro1
Application.EnableEvents = True
End If
End Sub

[Reklama]

[elninoslov]

Priložte prílohu, nech je jasnejšia logika volania makier 1, 2, 3, 4 ... Pôjde to, ale chce to poznať rozloženie a podmienky.

[Andrea320]

Dobrý den,
přílohu připojuji. V buňce D4 vyberete YES/NO podle toho se skryjí/odkryjí řádky pod buňkou. Tohle potřebuji aby se udělalo se všema zelenýma buňkama. Ty makra 1-6 které jsou tam nastavené, můžete klidně vložit přímo do toho kódu, jen pro mne to takhle bylo jednoduší.
Moc děkuji za pomoc

[elninoslov]

Vysporiada sa to aj s hromadnou zmenou, a ľahko môžete doplniť ďalšie rozsahy. Myslí aj na to, že skrytie prebehne aj pri prázdnej bunke, nielen "NO".

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCheck As Range, rngARE As Range, Col As Collection, rngHide As Range, rngUnhide As Range, aCheck() As String, aRows() As String, ADR As String, i As Integer

Const sCheck = "D4,D11,D22,D31"                 'Zoznam kontrolovaných buniek (oddelené čiarkou)
Const sRows = "5:10,12:21,23:30,32:40"          'Zoznam riadkov korešpondujúcich k zoznamu kontrolovaných buniek

    Set rngCheck = Intersect(Range(sCheck), Target) 'Kontrola zmeny v niektorej kontrolovanej bunke
    If Not rngCheck Is Nothing Then
        aCheck = Split(sCheck, ",")             'Rozdelenie kontrolovaných buniek do poľa
        aRows = Split(sRows, ",")               'Rozdelenie korešpondujúcich riadkov do poľa
       
        Set Col = New Collection                'Nová kolekcia na rýchle vyhľadanie korešpondujúcich riadkov k adrese bunky (cez kľúč)
        For i = 0 To UBound(aCheck)
            Col.Add aRows(i), aCheck(i)         'Priraď do kolekcie riadky pod kľúčom adresy bunky
        Next i
       
        For Each rngARE In rngCheck.Areas       'Prejdi všetky podoblasti (lebo bunky oddelené od seba sú oblasti)
            ADR = Col(rngARE.Cells(1).Address(0, 0))    'Zisti korešpondujúce riadky podľa adresy danej oblasti (zmenenej bunky)
            If rngARE.Cells(1).Value = "YES" Then       'Ak je hodnota oblasti/bunky "YES"
                If rngUnhide Is Nothing Then Set rngUnhide = Range(ADR) Else Set rngUnhide = Union(rngUnhide, Range(ADR))   'tak pridaj riadky k oblasti na zobrazenie
            Else                                        'ak je hodnota oblasti/bunky iná ako "YES" (môže byť len "NO" alebo "")
                If rngHide Is Nothing Then Set rngHide = Range(ADR) Else Set rngHide = Union(rngHide, Range(ADR))           'tak pridaj riadky k oblasti na skrytie
            End If
        Next rngARE
       
        Application.EnableEvents = False
        If Not rngUnhide Is Nothing Then rngUnhide.EntireRow.Hidden = False 'Ak je nejaká oblasť na zobrazenie, tak zobraz
        If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True      'Ak je nejaká oblasť na skrytie, tak skry
        Application.EnableEvents = True
       
        Set Col = Nothing                       'Zrušenie kolekcie
    End If
End Sub


Snáď to nieje príliš komplikované, snažil som sa to tam všetko popísať.

[Andrea320]

úúúžasné tohle bych nevymyslela ani za milion let strašně moc děkuji, funguje to perfektně

[Andrea320]

@elninoslov Dobrý den, před nedávnem jste mi pomáhal vymyslet kód výše, prosím šlo by to upravit tak, aby makro reagovalo nejen na manuální změnu, ale i na změnu ve vzorci? Hodnoty, které vzorec zobrazí budou pořád stejné - teda YES, NO nebo prázdná.
Moc děkuji za pomoc.