Hjælp til skjulte linjer i excel på baggrund af JA/NEJ valg.

Hej

Har du mulighed for at Uploade din fil?
Det skulle nok kunne lade sig gøre via VBA.

Hej supertekst.

Jeg har prøvet at uploade opgaven online:
http://www.gratisupload.dk/f/8u42p40uur/

Bemærk dog, at den i øjeblikket er en skabelon med kun 2 grupperinger, blot for at se om det kunne lade sig gøre :-)

Hej Kewin

Tak for det og ok - prøver - og vender tilbage..

Rem VBA-koden er anbragt under ark "Tidsbudget"
Rem I min model anvender jeg ikke grupperingen i venstre side
Rem Som du måske kan se anvender jeg kolonnen med Ja/Nej som argument for visning eller ej.
Rem Hvis du vil have min model - send en mail - @-adresse under min profil.

Const arkNavnTidsbudget = "TIDSBUDGET"
Const fraRæk = 8
Const tilRæk = 43
Const JaNejKolonne = "C"

Const arkNavnSpørgsmål = "Spørgsmål(2)"
Const områdeKolonne = "B"

Dim ræk As Integer, relevant As String, område As String
Public Sub SkjulGrupper()
    synliggørAlleOmråder
   
    Sheets(arkNavnTidsbudget).Activate
   
    For ræk = fraRæk To tilRæk
        relevant = ActiveSheet.Range(JaNejKolonne & ræk)
        If LCase(relevant) = "nej" Then
            område = ActiveSheet.Range(områdeKolonne & ræk)
            sletOmrådetsSpørgsmål område
        End If
    Next ræk
End Sub
Private Sub sletOmrådetsSpørgsmål(område)
Dim ræk As Integer, sidsteRække As Integer, flag As Boolean
    Application.ScreenUpdating = False
   
    Sheets(arkNavnSpørgsmål).Activate
    sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
       
    flag = False
   
    For ræk = 1 To sidsteRække
        If ActiveSheet.Range(områdeKolonne & ræk) = område And flag = False Then
            flag = True
            ActiveSheet.Rows(ræk).Hidden = True
        Else
            If ActiveSheet.Range(områdeKolonne & ræk) = "" And flag = True Then
                Exit For
            Else
                If flag = True Then
                    ActiveSheet.Rows(ræk).Hidden = True
                End If
            End If
        End If
    Next ræk
    Sheets(arkNavnTidsbudget).Activate
End Sub
Private Sub synliggørAlleOmråder()
Dim ræk As Integer, sidsteRække As Integer
    Sheets(arkNavnSpørgsmål).Activate
    sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
    For ræk = 1 To sidsteRække
        ActiveSheet.Rows(ræk).Hidden = False
    Next ræk
End Sub

Super, sender dig en mail med det samme!

Mange tak!

Så håber jeg på jeg kan få det til at lykkedes, eller henvender jeg mig måske igen :-)

Mvh.
Kewin

Du skal være velkommen..