VBA til skjule/vise kolonner/rækker

https://www.dropbox.com/s/sbsqga7iixtwnf9/Skjul%20R%C3%A6kker%20og%20Kolonner.xlsm?dl=0

# Jan Hansen, mange tak det virker. Dog ville jeg gerne i feltet C2, henvise til felt i andet ark (samme projektmappe), da jeg bruger "Enlig, Gift og samlever" reference i andre sammenhænge. Kan den ikke det, når man bruger VBA, det virker til den først reagerer på indtastning i C2, når man manuelt gør det.

God dag
Chris

Jeg har tilladt mig at omskrive Jan´s kode
Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C2,C3")) Is Nothing Then

Gør at kode køres når der ændres i celle C2 og C3 på den fane koden ligger.

prøv den nu:

https://www.dropbox.com/s/sbsqga7iixtwnf9/Skjul%20R%C3%A6kker%20og%20Kolonner.xlsm?dl=0

https://www.dropbox.com/s/uoy7bg5heyjmd6l/Skjul%20R%C3%A6kker%20og%20Kolonner%20%28SM%29.xlsm?dl=0

Helt i orden store-morten #3

det  er fint når ens kode kan optimeres/gøres mere let læslig!!

I # har lavet det om til et modul med en eventhandler i de to ark ellers er det en variant af den optimerede kode!!

Jan

# store-morten Jeg har forsøgt at smide den ind i VBA, men der sker fortsat ikke noget når jeg har været på ark1 for at ændre. Så så har den ikke fjernet rækker og kolonner på det ark6.

Jeg har ikke kunne downloade jeres fil, da dropbox ikke vil sende mig mail til nulstille password (har åbenbart glemt det).

Gør jeg noget forkert?

Koden skal ligge på det ark der ændres i og tilpasses til det ark der skal vises/skjules på.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C2,C3")) Is Nothing Then
        Worksheets("Ark1").Range("D:J").EntireColumn.Hidden = False
        Worksheets("Ark1").Range("13:22").EntireRow.Hidden = False
        Select Case Range("C2").Value
            Case "Enlig"
                Worksheets("Ark1").Range("E:H,J:J").EntireColumn.Hidden = True
                Worksheets("Ark1").Range("13:16,20:22").EntireRow.Hidden = True
            Case "Samlever", "Gift"
            Select Case Range("C3").Value
                Case "Nej", ""
                    Worksheets("Ark1").Range("G:I,D:D").EntireColumn.Hidden = True
                    Worksheets("Ark1").Range("19:19,21:22").EntireRow.Hidden = True
                    If Worksheets("Ark1").Range("F14").Value < Worksheets("Ark1").Range("U5").Value Or _
                        Worksheets("Ark1").Range("H12").Value < Worksheets("Ark1").Range("U4").Value Then
                        Worksheets("Ark1").Range("15:15").EntireRow.Hidden = True
                    End If
                Case "Ja"
                    Worksheets("Ark1").Range("D:F,I:J").EntireColumn.Hidden = True
                    Worksheets("Ark1").Range("16:16,13:14,19:20").EntireRow.Hidden = True
                    If Worksheets("Ark1").Range("F14").Value < Worksheets("Ark1").Range("U5").Value Or _
                        Worksheets("Ark1").Range("H12").Value < Worksheets("Ark1").Range("U4").Value Then
                        Worksheets("Ark1").Range("15:15").EntireRow.Hidden = True
                    End If
            End Select
        End Select
    End If
End Sub

Så de steder der står: Ark1 skal rettes til: Ark6

Eller:

Ok, på ark1 er Enlig/Gift/samlever på B27, og Ja/Nej er på B17. Jeg har forsøgt at udfylde C2 med B27, og C3 med B17

Så den ser således ud:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B27,B17")) Is Nothing Then
        Worksheets("Ark6").Range("D:J").EntireColumn.Hidden = False
        Worksheets("Ark6").Range("13:22").EntireRow.Hidden = False
        Select Case Range("B27").Value
            Case "Enlig"
                Worksheets("Ark6").Range("E:H,J:J").EntireColumn.Hidden = True
                Worksheets("Ark6").Range("13:16,20:22").EntireRow.Hidden = True
            Case "Samlever", "Gift"
            Select Case Range("B17").Value
                Case "Nej", ""
                    Worksheets("Ark6").Range("G:I,D:D").EntireColumn.Hidden = True
                    Worksheets("Ark6").Range("19:19,21:22").EntireRow.Hidden = True
                    If Worksheets("Ark6").Range("F14").Value < Worksheets("Ark6").Range("U5").Value Or _
                        Worksheets("Ark6").Range("H12").Value < Worksheets("Ark6").Range("U4").Value Then
                        Worksheets("Ark6").Range("15:15").EntireRow.Hidden = True
                    End If
                Case "Ja"
                    Worksheets("Ark6").Range("D:F,I:J").EntireColumn.Hidden = True
                    Worksheets("Ark6").Range("16:16,13:14,19:20").EntireRow.Hidden = True
                    If Worksheets("Ark6").Range("F14").Value < Worksheets("Ark6").Range("U5").Value Or _
                        Worksheets("Ark6").Range("H12").Value < Worksheets("Ark6").Range("U4").Value Then
                        Worksheets("Ark6").Range("15:15").EntireRow.Hidden = True
                    End If
            End Select
        End Select
    End If
End Sub

Men den kommer med Runtime error.

(Vil det sige at der ikke behøver være en C2 og C3 på Ark6, da den tager det direkte fra Ark1?

Jeg får ikke fejl :-)

Ja, den kikke på det ark koden ligger på (Ark1 Celle B17 og B27)
Og Viser/Skjuler på: Ark6

Har du omdøbt fanerne? Så Ark6 heder noget andet?

Ja det har jeg, troede nu godt den vidste det var ark6, omdøbt til "Sygdom (data)". Det er nu rettet, og det virker perfekt!

Det var godt du fik det til at virke ;-)

Jo, det kan man godt, men så er det ikke nemt at overskue.

Worksheets("Ark6").Range.........
Og
Worksheets(6).Range......... (bruger jeg stort set aldrig)

Så det bedre med:
Worksheets("Sygdom (data)").Range......

Bare af nygerrighed, hvad er det disse to gør?
                    If Worksheets("Ark6").Range("F14").Value < Worksheets("Ark6").Range("U5").Value Or _
                        Worksheets("Ark6").Range("H12").Value < Worksheets("Ark6").Range("U4").Value Then

Fra dit oplæg:

C2 = "Samlever" eller "Gift"                     
Kolonne D, G, H, I         
Række 19, 21, 22 - dertil række 15 hvis F14 < U5 eller H12 < U4

Hej store-morten

Den VBA du har givet mig gør lidt knas. Den vil have jeg indtaster i en special rækkefølge på "ark1" (Indtastning).

Hvis jeg f.eks. sætter samlever, dernæst "Ja", og så retter til værdi F14 < U5, så sker der ikke noget. Men sætter jeg sætter værdi ind først i F14 og indtaster Samlever dernæst "Ja", så viser den rækken 15 som den skal. Eller indtaster "samlever", indsætter værdi og dernæst vælger "Ja".
Det er som om den ikke aktiverer regel med række 15 hvis værdi i F14 indtastes sidst.

du skal udvide din eventhandler
If Not Intersect(Target, Range("B27,B17")) Is Nothing Then

til
If Not Intersect(Target, Range("B27,B17,F14")) Is Nothing Then

# Jan Hansen
Det løser desværre ikke problemet, det er fortsat det samme der sker

Jeg har flyttet lidt i det, B28 samlever, gift eller enlig
B18 Ja/Nej

Det er fortsat i stedet for det er række 15 er det nu 117 som skal væk hvis E116 er mindre E106

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B28,B18,I116, K114")) Is Nothing Then
        Worksheets("Sygdom (data)").Range("G:M").EntireColumn.Hidden = False
        Worksheets("Sygdom (data)").Range("115:124").EntireRow.Hidden = False
        Select Case Range("B28").Value
            Case "Enlig"
                Worksheets("Sygdom (data)").Range("H:K,M:M").EntireColumn.Hidden = True
                Worksheets("Sygdom (data)").Range("115:118,122:124").EntireRow.Hidden = True
            Case "Samlever", "Gift"
            Select Case Range("B18").Value
                Case "Nej", ""
                    Worksheets("Sygdom (data)").Range("J:L,G:G").EntireColumn.Hidden = True
                    Worksheets("Sygdom (data)").Range("121:121,123:124").EntireRow.Hidden = True
                    If Worksheets("Sygdom (data)").Range("I116").Value < Worksheets("Sygdom (data)").Range("E106").Value Then
                        Worksheets("Sygdom (data)").Range("117:117").EntireRow.Hidden = True
                    End If
                Case "Ja"
                    Worksheets("Sygdom (data)").Range("G:I,L:M").EntireColumn.Hidden = True
                    Worksheets("Sygdom (data)").Range("115:116,121:122").EntireRow.Hidden = True
                    If Worksheets("Sygdom (data)").Range("K114").Value < Worksheets("Sygdom (data)").Range("D106").Value Then
                        Worksheets("Sygdom (data)").Range("117:117").EntireRow.Hidden = True
                    End If
            End Select
        End Select
    End If

Prøv denne: