VBA worksheet change pro víc buňek

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Andrea320
nováček
Příspěvky: 6
Registrován: říjen 19
Pohlaví: Žena

VBA worksheet change pro víc buňek

Příspěvekod Andrea320 » 13 srp 2020 23:16

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
Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 273
Registrován: červen 13
Pohlaví: Muž

Re: VBA worksheet change pro víc buňek

Příspěvekod elninoslov » 13 srp 2020 23:50

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
nováček
Příspěvky: 6
Registrován: říjen 19
Pohlaví: Žena

Re: VBA worksheet change pro víc buňek

Příspěvekod Andrea320 » 14 srp 2020 10:53

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 :-)
Nemáte oprávnění prohlížet přiložené soubory.

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 273
Registrován: červen 13
Pohlaví: Muž

Re: VBA worksheet change pro víc buňek

Příspěvekod elninoslov » 14 srp 2020 12:11

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ť.
Nemáte oprávnění prohlížet přiložené soubory.

Andrea320
nováček
Příspěvky: 6
Registrován: říjen 19
Pohlaví: Žena

Re: VBA worksheet change pro víc buňek

Příspěvekod Andrea320 » 14 srp 2020 14:34

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

Andrea320
nováček
Příspěvky: 6
Registrován: říjen 19
Pohlaví: Žena

Re: VBA worksheet change pro víc buňek

Příspěvekod Andrea320 » 12 říj 2020 00:07

@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.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Změna více buněk najednou
    od ostiepok » 01 zář 2020 08:26 » v Kancelářské balíky
    2
    646
    od elninoslov
    01 zář 2020 14:59
  • Podbarvení buněk na základě hodnoty v buňce
    od luko02420 » 03 dub 2020 03:42 » v Kancelářské balíky
    2
    388
    od luko02420
    03 dub 2020 07:45
  • aktivace makra při změně označených buněk v daném rozsahu
    od ynka » 24 dub 2020 13:32 » v Kancelářské balíky
    0
    484
    od ynka
    24 dub 2020 13:32

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot], Majestic-12 [Bot] a 0 hostů