CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg
Cookie ikon
Avatar billede chrped Nybegynder
18. januar 2012 - 12:59 Der er 6 kommentarer og
1 løsning

Skjul/vis celler hvis andre udfyldes

Hej,

Jeg har et nu et ark (ark3), som på baggrund af udfyldt felter i Ark 1, bliver overførte - f.eks. hvis der sættes tallet 1 i F14 i Ark1, så bliver der en linje vist i Ark 3, hvorimod hvis der intet er i Ark1 celle F14, så bliver linjen skjult. Og sådan fortsætter det op til række 1790.

For at ovenstående virker bruges følgende:

Private Sub Worksheet_Activate()
Sheets("Ark3").Range("A16").AutoFilter
Sheets("Ark3").Range("$A$16:$H$2000").AutoFilter Field:=4, Criteria1:="<>"
End Sub

Private Sub Worksheet_Deactivate()
Sheets("Ark3").Range("A16").AutoFilter
Sheets("Ark3").Range("A:H").AutoFilter Field:=4
End Sub


Nu vil jeg så gerne have noget mere - som skal gøres EFTER OVENSTÅENDE!!

Jeg vil gerne have, at hvis man sætte et kryds i I17 i Ark 3, så kommer kolonne j og k frem - hvis der derimod ikke sættes kryds, bliver de skjulte. Dette skal gælde hele vejen ned til række 1790.
Det samme skal så ske før følgende felter/områder:
Kryds i L17 = vis M, N, O, P Q, R.

Da antallet af kolonner der skal vises er forskellige fra område til område, håber jeg at jeg kan se mig ud af det i jeres/din Makro :)

PFT,
Christian
Avatar billede Ialocin Novice
18. januar 2012 - 14:37 #1
Hej Christian

Ved ikke om jeg rammer helt rigtig med følgende ?, men det er da en start :o)

Koden reagerer hvis der tastes X i I17 og L17 på Ark3.

Kopier følgende kode ind i dit arks Change_Hændelse.


Dim cTarget As String

    'sæt cTarget = den aktive celles adresse
    cTarget = Target.Address
   
   
        'vælg i forhold til celle adressen
        Select Case cTarget
       
            'celle I17
            Case "$I$17"
       
                'hvis der er et x i cellen
                If Ark3.Range("I17").Value = "x" Then
               
                    'skjul kolonne J:K
                    Ark3.Range("J:K").EntireColumn.Hidden = True
                                 
                'ellers
                Else
                   
                    'vis kolonne J:K
                    Ark3.Range("J:K").EntireColumn.Hidden = False
                         
                End If
               
            'celle L17
            Case "$L$17"
       
                'hvis der er et x i cellen
                If Ark3.Range("L17").Value = "x" Then
               
                    'skjul kolonne M:R
                    Ark3.Range("M:R").EntireColumn.Hidden = True
               
                Else
               
                    'vis kolonne M:R
                    Ark3.Range("M:R").EntireColumn.Hidden = False
                         
                End If
           
            End Select
           
End Sub


Med venlig hilsen, Nicolai
Avatar billede chrped Nybegynder
18. januar 2012 - 16:06 #2
Hej Nicolai,

Eftersom jeg er helt grøn vedr. makroer, så ved jeg ikke engang hvor og hvordan jeg skal taste det ind henne - ved det er under VBA men ikke mht ark osv. Så når du nævner "Change_Hændelse" så er jeg ikke helt med ?!

Og hvordan får jeg denne makro til at køre automatisk ?
Avatar billede store-morten Ekspert
18. januar 2012 - 19:54 #3
Lægges samme sted som de to overstående
Private Sub Worksheet_Change(ByVal Target As Range)

'Tolkebokse
If Not Intersect(Range("I17:I1790"), Target) Is Nothing Then
Range("J:K").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("I" & i) = "x" Then Range("J:K").EntireColumn.Hidden = False
Next
End If
'Panel
If Not Intersect(Range("L17:L1790"), Target) Is Nothing Then
Range("M:R").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("L" & i) = "x" Then Range("M:R").EntireColumn.Hidden = False
Next
End If
'Talerstol
If Not Intersect(Range("S17:S1790"), Target) Is Nothing Then
Range("T:W").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("S" & i) = "x" Then Range("T:W").EntireColumn.Hidden = False
Next
End If
'Podier
If Not Intersect(Range("X17:X1790"), Target) Is Nothing Then
Range("Y:AA").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("X" & i) = "x" Then Range("Y:AA").EntireColumn.Hidden = False
Next
End If
'Mikrofon
If Not Intersect(Range("AB17:AB1790"), Target) Is Nothing Then
Range("AC:AD").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AB" & i) = "x" Then Range("AC:AD").EntireColumn.Hidden = False
Next
End If
'Projekter + lærred
If Not Intersect(Range("AE17:AE1790"), Target) Is Nothing Then
Range("AF:AG").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AE" & i) = "x" Then Range("AF:AG").EntireColumn.Hidden = False
Next
End If
'Skærm
If Not Intersect(Range("AH17:AH1790"), Target) Is Nothing Then
Range("AI:AJ").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AH" & i) = "x" Then Range("AI:AJ").EntireColumn.Hidden = False
Next
End If
'Taletidstimer
If Not Intersect(Range("AK17:AK1790"), Target) Is Nothing Then
Range("AL:AM").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AK" & i) = "x" Then Range("AL:AM").EntireColumn.Hidden = False
Next
End If
'Kamera
If Not Intersect(Range("AN17:AN1790"), Target) Is Nothing Then
Range("AO:AQ").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AN" & i) = "x" Then Range("AO:AQ").EntireColumn.Hidden = False
Next
End If
'Teleslynge
If Not Intersect(Range("AR17:AR1790"), Target) Is Nothing Then
Range("AS:AT").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AR" & i) = "x" Then Range("AS:AT").EntireColumn.Hidden = False
Next
End If
'TV
If Not Intersect(Range("AU17:AU1790"), Target) Is Nothing Then
Range("AV:AY").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AU" & i) = "x" Then Range("AV:AY").EntireColumn.Hidden = False
Next
End If
'Banner
If Not Intersect(Range("AZ17:AZ1790"), Target) Is Nothing Then
Range("BA:BD").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("AZ" & i) = "x" Then Range("BA:BD").EntireColumn.Hidden = False
Next
End If
'Backdrops
If Not Intersect(Range("BE17:BE1790"), Target) Is Nothing Then
Range("BF:BI").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("BE" & i) = "x" Then Range("BF:BI").EntireColumn.Hidden = False
Next
End If
'Blomster
If Not Intersect(Range("BJ17:BJ1790"), Target) Is Nothing Then
Range("BK:BN").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("BJ" & i) = "x" Then Range("BK:BN").EntireColumn.Hidden = False
Next
End If
'Strøm
If Not Intersect(Range("BO17:BO1790"), Target) Is Nothing Then
Range("BP:BR").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("BO" & i) = "x" Then Range("BP:BR").EntireColumn.Hidden = False
Next
End If
'Fax
If Not Intersect(Range("BS17:BS1790"), Target) Is Nothing Then
Range("BT:BU").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("BS" & i) = "x" Then Range("BT:BU").EntireColumn.Hidden = False
Next
End If
'Fastnet
If Not Intersect(Range("BV17:BV1790"), Target) Is Nothing Then
Range("BW:BX").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("BV" & i) = "x" Then Range("BW:BX").EntireColumn.Hidden = False
Next
End If
'Kablet internet
If Not Intersect(Range("BY17:BY1790"), Target) Is Nothing Then
Range("BZ:CA").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("BY" & i) = "x" Then Range("BZ:CA").EntireColumn.Hidden = False
Next
End If
'Kaffemaskine
If Not Intersect(Range("CB17:CB1790"), Target) Is Nothing Then
Range("CC:CD").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("CB" & i) = "x" Then Range("CC:CD").EntireColumn.Hidden = False
Next
End If
'LYS
If Not Intersect(Range("CE17:CE1790"), Target) Is Nothing Then
Range("CF:CI").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("CE" & i) = "x" Then Range("CF:CI").EntireColumn.Hidden = False
Next
End If
'Inventar
If Not Intersect(Range("CJ17:CJ1790"), Target) Is Nothing Then
Range("CK:CP").EntireColumn.Hidden = True
For i = 17 To 1790
    If Range("CJ" & i) = "x" Then Range("CK:CP").EntireColumn.Hidden = False
Next
End If

End Sub
Avatar billede Ialocin Novice
18. januar 2012 - 22:36 #4
Hej Christian

Okay ... jeg skal prøve at guide dig igennem :o)

- Åben din Excel fil
- Tast ALT + F11, hvilket gør, at du åbner VBA editoren.
- tast CTRL + R, hvilket åbner Projekt Exploreren.

Nu burde du ha´ overblik over de enkelte ark i filen ??

- Dobbeltklik på Ark3, hvorefter kodevinduet for arket åbnes.
- I dropdownboksen, øverst til venstre, vælges Worksheet
- I dropdownboksen, øverst til højre, vælges Change

Nu burde der være oprettet en tom hændelses rutine/procedure ?? med følgende udseende:

Private Sub Worksheet_Change(ByVal Target As Range)
           
End Sub


Imellem rutinens start og slut linie kopieres selve koden der skal aktiveres, når der sker en ændring på Ark3.

Så kopier denne kode ind umiddelbart under Private Sub Worksheet_Change(ByVal Target As Range):

Dim cTarget As String

    'sæt cTarget = den aktive celles adresse
    cTarget = Target.Address
   
   
        'vælg i forhold til celle adressen
        Select Case cTarget
       
            'celle I17
            Case "$I$17"
       
                'hvis der er et x i cellen
                If Sheet1.Range("I17").Value = "x" Then
               
                    'skjul kolonne J:K
                    Sheet1.Range("J:K").EntireColumn.Hidden = True
                                 
                'ellers
                Else
                   
                    'vis kolonne J:K
                    Sheet1.Range("J:K").EntireColumn.Hidden = False
                         
                End If
               
            'celle L17
            Case "$L$17"
       
                'hvis der er et x i cellen
                If Sheet1.Range("L17").Value = "x" Then
               
                    'skjul kolonne M:R
                    Sheet1.Range("M:R").EntireColumn.Hidden = True
               
                Else
               
                    'vis kolonne M:R
                    Sheet1.Range("M:R").EntireColumn.Hidden = False
                         
                End If
           
            End Select


Luk herefter VBA editoren og du burde være kørende ... om det så er det du ønsker ???

Hændelsen aktiveres hver gang Ark3 ændres, men selve koden udføres kun hvis ændringen sker i celle I17 eller L17.

Med venlig hilsen, Nicolai
Avatar billede store-morten Ekspert
18. januar 2012 - 23:02 #5
#Nicolai

Jeg vil gerne have, at hvis man sætte et kryds i I17 i Ark 3, så kommer kolonne j og k frem - hvis der derimod ikke sættes kryds, bliver de skjulte. Dette skal gælde hele vejen ned til række 1790.
Det samme skal så ske før følgende felter/områder:
Kryds i L17 = vis M, N, O, P Q, R.


et kryds i I17 i Ark 3, så kommer kolonne j og k frem - hvis der derimod ikke sættes kryds, bliver de skjulte.
Skal gælde for I17:I1790 ikke kun I17 men alle 1773 rækker.

Så hvis der ikke er x i celle I17 men et x i celle I1200 så skal kolonne j og k frem
Hvis der ikke er x i cellerne I17:I1790 skal kolonne j og k skjules.
Avatar billede Ialocin Novice
18. januar 2012 - 23:38 #6
Hej Store-Morten

Du har sikkert ret ... ?

Hvis Morten har svaret, så følg #4 og kopier Store-Mortens koden ind mellem:

Private Sub Worksheet_Change(ByVal Target As Range)
           
End Sub



Med venlig hilsen, Nicolai
Avatar billede store-morten Ekspert
27. januar 2012 - 14:14 #7
Hej Christian

Jeg lægger et 'Svar' så du kan tildele point. :-)
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
Excel kurser
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Markere et område der ikke skal med i sum Af lurup i Excel 1 I dag 14:44 I dag 18:31
Kan det gøres lettere Af densortehingst i Excel 10 02/08/202410:07 I går 02:42
visning af heltal som resultat efter beregning Af Brian_Skovgaard i Excel 2 01/08/202421:28 02/08/202409:32
Betinget formatering Af Ninna i Excel 1 23/07/202413:03 23/07/202419:56
Opdater et ark Af lurup i Excel 2 22/07/202422:23 23/07/202416:41
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester



Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I dag 16:27 Musikafspiller på Samsung S10 telefon Af mort1 i Mobiltelefoner
I dag 14:44 Markere et område der ikke skal med i sum Af lurup i Excel
I dag 11:04 Bedste Bærbar Af mikerojakes i PC
I dag 09:46 Elektronisk lup til billeder Af KurtG i Browsere
I går 10:57 Pinnacle videoredigering Af gerhardpet i Billedbehandling
White papers
Flere white papers »


Premium
Teaser billede
Nvidia efterforskes for brud på konkurrencelov
Læs mere »
Den store cloud-krig raser stadigvæk - og Amazon ser lige nu ud til at have overhånden
Apple præsenter første regnskab siden AI-udmelding: Her er tre bemærkelsesværdige pointer derfra
Sårbarhed kan let give administratorrettigheder til alle: Udnyttes allerede af ransomware-grupper
Se alle »
Computerworld
Teaser billede
Første test: Denne helt nye wunder-CPU vil du have i din næste laptop
Læs mere »
Alvorlig fejl i Intel-chips breder sig: Listen over ramte processor vokser og vokser – og de kan blive permanent beskadigede
’Apple Intelligence’ slippes løs: Her kommer første mulighed for at afprøve Apples kunstige intelligens
Flere statslige it-løsninger ramt af netværksproblemer - ansatte kunne ikke få mail-adgang
Se alle »
CIO
Teaser billede
Stor aftale gør Microsofts datacentre hurtigere - investerer i netværksudstyr
Læs mere »
Telenor skrotter ældre it-system: Nyt system er en hyldevare
Derfor står Danske Bank foran en kæmpe AWS-transformation: Ellers skulle vi bygge en ny infrastruktur for at følge med
NIS2 i Danmark udskydes med flere måneder: Her er den nye dato, hvor loven træder i kraft
Se alle »
Job & Karriere
Teaser billede
Efter 12 år er NNIT's hovedkvarter i Søborg nu ryddet og tomt - alle arbejder hjemme: "Det er med et vist vemod"
Læs mere »
KMD-direktør forlader selskabet: Det skal hun nu
Dansk top-profil trækker sig fra Microsoft: Skal være direktør i TDC Erhverv
IBM Danmark skifter ud i sin øverste ledelse - her er den nye direktion
Se alle »
White paper
Teaser billede
Sådan får du overblik og beskytter dine cloudapplikationer
Læs mere »
Det behøver ikke at gøre ondt: Sådan gør du livet lettere for kunder med multicloud
Sæt turbo på din cloudperformance og minimér risikoen for DDoS-angreb
Rapport kortlægger de 13 bedste muligheder for at sætte turbo på din cloud computing
Se alle »

Events
Flere events »
White papers
Flere white papers »
IT-Kurser
Se alle vores it-kurser »