Avatar billede Niessau Juniormester
08. september 2019 - 01:09 Der er 20 kommentarer og
1 løsning

VBA til skjule/vise kolonner/rækker

Hej med jer

Jeg er ikke den skarpeste på VBA, men det er skide smart. Jeg har brug for lidt hjælp, eller skal jeg bruge en masse HVIS formler.

Felt C2 kan der stå Enlig eller Samlever eller Gift.
Felt C3 kan der stå Ja eller Nej

Jeg har brug for følgende kolonner og rækker fjernes når:
C2 = "Enlig"       
Kolonne E, F, G, H, J           
Række 13, 14, 15, 16, 20, 21, 22           

C2 = "Samlever" eller "Gift"                       
Kolonne D, G, H, I           
Række 19, 21, 22 - dertil række 15 hvis F14 < U5 eller H12 < U4           
                   
C2 = "Samlever" eller "Gift" og C3 = "Ja"
Kolonne D, E, F, I, J           
Række 13, 14, 16, 19, 20 - dertil række 15 hvis F14 < U5 eller H12 < U4

Lad mig høre fra jer, håber der er en som kan hjælpe

God weekend
Chris
Avatar billede Jan Hansen Ekspert
08. september 2019 - 08:27 #1

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


https://www.dropbox.com/s/sbsqga7iixtwnf9/Skjul%20R%C3%A6kker%20og%20Kolonner.xlsm?dl=0
Avatar billede Niessau Juniormester
08. september 2019 - 11:36 #2
# 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
Avatar billede store-morten Ekspert
08. september 2019 - 11:52 #3
Jeg har tilladt mig at omskrive Jan´s kode
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C2,C3")) Is Nothing Then
        Range("D:J").EntireColumn.Hidden = False
        Range("13:22").EntireRow.Hidden = False
        Select Case Range("C2").Value
            Case "Enlig"
                Range("E:H,J:J").EntireColumn.Hidden = True
                Range("13:16,20:22").EntireRow.Hidden = True
            Case "Samlever", "Gift"
            Select Case Range("C3").Value
                Case "Nej", ""
                    Range("G:I,D:D").EntireColumn.Hidden = True
                    Range("19:19,21:22").EntireRow.Hidden = True
                    If Range("F14").Value < Range("U5").Value Or _
                        Range("H12").Value < Range("U4").Value Then
                        Range("15:15").EntireRow.Hidden = True
                    End If
                Case "Ja"
                    Range("D:F,I:J").EntireColumn.Hidden = True
                    Range("16:16,13:14,19:20").EntireRow.Hidden = True
                    If Range("F14").Value < Range("U5").Value Or _
                        Range("H12").Value < Range("U4").Value Then
                        Range("15:15").EntireRow.Hidden = True
                    End If
            End Select
        End Select
    End If
End Sub

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.
Avatar billede Jan Hansen Ekspert
08. september 2019 - 12:20 #4
Avatar billede Jan Hansen Ekspert
08. september 2019 - 12:34 #6
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
Avatar billede Niessau Juniormester
08. september 2019 - 20:12 #7
# 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?
Avatar billede store-morten Ekspert
08. september 2019 - 20:25 #8
Koden skal ligge på det ark der ændres i og tilpasses til det ark der skal vises/skjules på.
Avatar billede store-morten Ekspert
08. september 2019 - 20:28 #9
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
Avatar billede store-morten Ekspert
08. september 2019 - 20:30 #10
Så de steder der står: Ark1 skal rettes til: Ark6
Avatar billede store-morten Ekspert
08. september 2019 - 20:37 #11
Eller:
Private Sub Worksheet_Change(ByVal Target As Range)

VisSkjulArk = "Ark1"    '<-- Tilrettes

    If Not Intersect(Target, Range("C2,C3")) Is Nothing Then
        Worksheets(VisSkjulArk).Range("D:J").EntireColumn.Hidden = False
        Worksheets(VisSkjulArk).Range("13:22").EntireRow.Hidden = False
        Select Case Range("C2").Value
            Case "Enlig"
                Worksheets(VisSkjulArk).Range("E:H,J:J").EntireColumn.Hidden = True
                Worksheets(VisSkjulArk).Range("13:16,20:22").EntireRow.Hidden = True
            Case "Samlever", "Gift"
            Select Case Range("C3").Value
                Case "Nej", ""
                    Worksheets(VisSkjulArk).Range("G:I,D:D").EntireColumn.Hidden = True
                    Worksheets(VisSkjulArk).Range("19:19,21:22").EntireRow.Hidden = True
                    If Worksheets(VisSkjulArk).Range("F14").Value < Worksheets(VisSkjulArk).Range("U5").Value Or _
                        Worksheets(VisSkjulArk).Range("H12").Value < Worksheets(VisSkjulArk).Range("U4").Value Then
                        Worksheets(VisSkjulArk).Range("15:15").EntireRow.Hidden = True
                    End If
                Case "Ja"
                    Worksheets(VisSkjulArk).Range("D:F,I:J").EntireColumn.Hidden = True
                    Worksheets(VisSkjulArk).Range("16:16,13:14,19:20").EntireRow.Hidden = True
                    If Worksheets(VisSkjulArk).Range("F14").Value < Worksheets(VisSkjulArk).Range("U5").Value Or _
                        Worksheets(VisSkjulArk).Range("H12").Value < Worksheets(VisSkjulArk).Range("U4").Value Then
                        Worksheets(VisSkjulArk).Range("15:15").EntireRow.Hidden = True
                    End If
            End Select
        End Select
    End If
End Sub
Avatar billede Niessau Juniormester
08. september 2019 - 20:42 #12
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?
Avatar billede store-morten Ekspert
08. september 2019 - 20:54 #13
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?
Avatar billede Niessau Juniormester
08. september 2019 - 20:59 #14
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!
Avatar billede store-morten Ekspert
08. september 2019 - 21:12 #15
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......
Avatar billede Niessau Juniormester
08. september 2019 - 21:24 #16
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
Avatar billede store-morten Ekspert
08. september 2019 - 21:28 #17
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
Avatar billede Niessau Juniormester
11. september 2019 - 00:22 #18
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.
Avatar billede Jan Hansen Ekspert
11. september 2019 - 02:24 #19
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
Avatar billede Niessau Juniormester
11. september 2019 - 18:35 #20
# 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
Avatar billede store-morten Ekspert
11. september 2019 - 19:37 #21
Prøv denne:
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
       
        If Range("B28").Value = "Enlig" Then
                Worksheets("Sygdom (data)").Range("H:K,M:M").EntireColumn.Hidden = True
                Worksheets("Sygdom (data)").Range("115:118,122:124").EntireRow.Hidden = True
        End If
       
        If Range("B28").Value = "Samlever" Or Range("B28").Value = "Gift" Then
        If Range("B18").Value = "Ja" Then
                Worksheets("Sygdom (data)").Range("G:I,L:M").EntireColumn.Hidden = True
                Worksheets("Sygdom (data)").Range("115:116,121:122").EntireRow.Hidden = True
        End If
        End If
       
        If Range("B28").Value = "Samlever" Or Range("B28").Value = "Gift" Then
        If Range("B18").Value = "Nej" Then
                Worksheets("Sygdom (data)").Range("J:L,G:G").EntireColumn.Hidden = True
                Worksheets("Sygdom (data)").Range("121:121,123:124").EntireRow.Hidden = True
        End If
        End If
       
        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
       
        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 If
         
End Sub
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester