CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg
Cookie ikon
Avatar billede msoela Nybegynder
21. maj 2012 - 15:52 Der er 16 kommentarer og
1 løsning

Vis/skjul makro

Hej eksperter

Nogen der kan være behjælpelig med en makro som udfører følgende handling:

Når der klikkes på en knap (gerne som hyperlink hvis muligt), så skjules alle øvrige kolonner med undtagelse af den kolonne markøren står i samt kolonnerne A-F. Klikkes der igen vises alle arkets kolonner igen.

Samtidig skal alle rækker uden indhold i kolonnen man står i skjules - med undtagelse af række 1-8.

Eksempel:
Hvis der er intastet noget i I10, I15 og I17 vil kolonnerne G,H,J-"sidste kolonne" være skjult. Ligeledes vil alle rækker bortset fra 1-8,10,15,17 være skjult.

Makroen skal reelt kunne bruges for samtlige kolonner (enkeltvist) og med undtagelse af kolonne A-F. Kan jeg undgå at skulle indsætte en "actionbutton" øverst i hver kolonne - kan der eventuelt bruges hyperlinks til at køre makroen?
Avatar billede store-morten Ekspert
21. maj 2012 - 19:49 #1
Prøv med:
Sub Vis_skjul()
home = ActiveCell.Address
homeArk = ActiveSheet.Name
antrk = ActiveSheet.UsedRange.Rows.Count
LastColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
LastColumnLetter = Left(Cells(1, LastColumn).Address(1, 0), _
InStr(1, Cells(1, LastColumn).Address(1, 0), "$") - 1)
KolBog = Mid(home, 2, InStr(2, home, "$") - 2)

Application.ScreenUpdating = False

Select Case KolBog
    Case "A" To "F"
      Exit Sub
End Select

If Columns("G:" & LastColumnLetter).Hidden = True Then GoTo Vis

Columns("G:" & LastColumnLetter).Hidden = True

KolBog = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Columns(KolBog).Hidden = False
    For Række = 9 To antrk
    If Range(KolBog & Række) = "" Then
    Rows(Række).Select
    Selection.EntireRow.Hidden = True
    End If
    Next
GoTo skjul
   
Vis:
Columns("G:" & LastColumnLetter).Hidden = False
Cells.EntireRow.Hidden = False
Sheets(homeArk).Select
Range(home).Select
skjul:
Application.ScreenUpdating = True
Sheets(homeArk).Select
Range(home).Select
End Sub
Avatar billede store-morten Ekspert
22. maj 2012 - 15:39 #2
Sub Vis_skjul()
home = ActiveCell.Address
homeArk = ActiveSheet.Name
antrk = ActiveSheet.UsedRange.Rows.Count
LastColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
LastColumnLetter = Left(Cells(1, LastColumn).Address(1, 0), _
InStr(1, Cells(1, LastColumn).Address(1, 0), "$") - 1)
KolBog = Mid(home, 2, InStr(2, home, "$") - 2)

Select Case KolBog
    Case "A" To "F"
      Exit Sub
End Select

Application.ScreenUpdating = False

If Columns("G:" & LastColumnLetter).Hidden = True Then GoTo Vis

Columns("G:" & LastColumnLetter).Hidden = True

KolBog = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Columns(KolBog).Hidden = False
    For Række = 9 To antrk
    If Range(KolBog & Række) = "" Then
    Rows(Række).Select
    Selection.EntireRow.Hidden = True
    End If
    Next
GoTo skjul
   
Vis:
Columns("G:" & LastColumnLetter).Hidden = False
Cells.EntireRow.Hidden = False
Sheets(homeArk).Select
Range(home).Select
skjul:
Application.ScreenUpdating = True
Sheets(homeArk).Select
Range(home).Select
End Sub
Avatar billede msoela Nybegynder
23. maj 2012 - 10:59 #3
Hej Morten

Hvis jeg forsøger mig med ovenstående, så skjuler den ikke samtlige 0 rækker?

Talmaterialet kunne se således ud

1

1
2
64
87




89
89


894
1

156

67

Med lignende mellemrum mellem de enkelte rækker. Her beholder den nogle af mellemrummene hvis jeg kører makroen.

Var der forresten mulighed for at afspille makroen ved hjælp af hyperlinks (altså at det er en tekst f.eks. "vis/skjul" man placerede i række 1 i samtlige kolonner således at hvis man klikker på teksten, så udfører den makroen for den kolonne man klikker i?
Avatar billede store-morten Ekspert
23. maj 2012 - 14:57 #4
Virker det ikke, hvis du markere en celle, i kolonne G og ud?

F.eks. klik på en celle i kolonne H og kør makro.
Alle kolonner fra G og så langt ud hvor der er data, skjules, untagen H
Rækker uden indhold, og så langt ned hvor der er data, skjules.

Køres makro når der er skjulte kolonner vises alt.
Avatar billede msoela Nybegynder
23. maj 2012 - 15:07 #5
Såfremt jeg kopierer det taleksempel ind i kolonne J, som jeg oplyste i min sidste post, så skjuler den ikke mellemrummet mellem de 2 første 1-taller, ligeledes skjuler den ikke mellemrummet mellem 87 og 89. Hermed bliver der altså "huller" hvor der ikke er indhold i.

Den skjuler rigtigt nok kolonne H og I.

Jeg ville samtidig gerne hvis den også ville skjule K-XFD, hvis man står placeret i kolonne J altså at den skjuler kolonner før og efter den kolonne man står i.
Avatar billede store-morten Ekspert
23. maj 2012 - 15:21 #6
Samtidig skal alle rækker uden indhold i kolonnen man står i skjules - med undtagelse af række 1-8.

Makroen skjuler først fra række 9 og ned, er det derfor?
Avatar billede store-morten Ekspert
23. maj 2012 - 15:33 #7
Mener du at alle kolonner ud af skal skjules?
Sub Vis_skjul()
home = ActiveCell.Address
homeArk = ActiveSheet.Name
antrk = ActiveSheet.UsedRange.Rows.Count
KolBog = Mid(home, 2, InStr(2, home, "$") - 2)

Select Case KolBog
    Case "A" To "F"
      Exit Sub
End Select

Application.ScreenUpdating = False

If Columns("G:XFD").Hidden = True Then GoTo Vis

Columns("G:XFD").Hidden = True

KolBog = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Columns(KolBog).Hidden = False
    For Række = 9 To antrk
    If Range(KolBog & Række) = "" Then
    Rows(Række).Select
    Selection.EntireRow.Hidden = True
    End If
    Next
GoTo skjul
   
Vis:
Columns("G:XFD").Hidden = False
Cells.EntireRow.Hidden = False
Sheets(homeArk).Select
Range(home).Select
skjul:
Application.ScreenUpdating = True
Sheets(homeArk).Select
Range(home).Select
End Sub
Avatar billede msoela Nybegynder
23. maj 2012 - 16:04 #8
Nu skjuler makroen kolonnerne optimalt!

Men prøv at indtaste nedenstående fra celle J9 og nedefter:
1

1
2
64
87




89
89


894
1

156

67

Her skjuler makroen rigtigt nok mellemrummene mellem 87 og 89 men ikke mellemrummene mellem 89 og 894, 1 og 156 samt 156 og 67.
Avatar billede store-morten Ekspert
23. maj 2012 - 16:09 #9
Hos mig, ingen problem?
Avatar billede msoela Nybegynder
23. maj 2012 - 16:14 #10
Underligt, her viser den tallene på følgende måde når makroen køres:
J9    1
J11    1
J12    2
J13    64
J14    87
J19    89
J20    89
J21   
J22   
J23    894
J24    1
J25   
J26    156
J27   
J28    67

Hvor J21,J22,J25,J27 burde blive skjult af makroen.

Kører office 2007.
Avatar billede store-morten Ekspert
23. maj 2012 - 16:18 #11
Prøv lige at teste denne:
Sub Vis_skjul()
home = ActiveCell.Address
homeArk = ActiveSheet.Name
antrk = ActiveSheet.UsedRange.Rows.Count
KolBog = Mid(home, 2, InStr(2, home, "$") - 2)

Select Case KolBog
    Case "A" To "F"
      Exit Sub
End Select

Application.ScreenUpdating = False

If Columns("G:XFD").Hidden = True Then GoTo Vis

Columns("G:XFD").Hidden = True

KolBog = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Columns(KolBog).Hidden = False
    For Række = 9 To 28
    If Range(KolBog & Række) = "" Then
    Rows(Række).Select
    Selection.EntireRow.Hidden = True
    End If
    Next
GoTo skjul
   
Vis:
Columns("G:XFD").Hidden = False
Cells.EntireRow.Hidden = False
Sheets(homeArk).Select
Range(home).Select
skjul:
Application.ScreenUpdating = True
Sheets(homeArk).Select
Range(home).Select
End Sub
Avatar billede msoela Nybegynder
23. maj 2012 - 16:21 #12
Perfekt :) Det var lige hvad der skulle til!

Smid et svar, det fungerer præcis som ønsket nu.
Avatar billede store-morten Ekspert
23. maj 2012 - 16:23 #13
Det var kun for at finde fejlen ;-)

2007 kender åbenbart ikke
ActiveSheet.UsedRange.Rows.Count

I "testen" skjules kun til række 28
Avatar billede msoela Nybegynder
23. maj 2012 - 16:39 #14
Kan det passe at du i den sidte kode du har pastet, har deaktiveret muligheden for at køre makroen 2. gang og dermed vise skjulte celler/rækker igen? :)
Avatar billede store-morten Ekspert
23. maj 2012 - 16:52 #15
Nej

Er det et fast antal rækker?
Avatar billede store-morten Ekspert
23. maj 2012 - 17:31 #16
Sub Vis_skjul()
home = ActiveCell.Address
homeArk = ActiveSheet.Name
antrk = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
KolBog = Mid(home, 2, InStr(2, home, "$") - 2)

Select Case KolBog
    Case "A" To "F"
      Exit Sub
End Select

Application.ScreenUpdating = False

If Columns("G:XFD").Hidden = True Then GoTo Vis

Columns("G:XFD").Hidden = True

KolBog = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Columns(KolBog).Hidden = False
    For Række = 9 To antrk
    If Range(KolBog & Række) = "" Then
    Rows(Række).Select
    Selection.EntireRow.Hidden = True
    End If
    Next
GoTo skjul
   
Vis:
Columns("G:XFD").Hidden = False
Cells.EntireRow.Hidden = False
Sheets(homeArk).Select
Range(home).Select
skjul:
Application.ScreenUpdating = True
Sheets(homeArk).Select
Range(home).Select
End Sub
Avatar billede store-morten Ekspert
23. maj 2012 - 22:51 #17
Denne burde virke, testet i Excel 2003:
Sub Vis_skjul()
home = ActiveCell.Address
homeArk = ActiveSheet.Name
antrk = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
KolBog = Mid(home, 2, InStr(2, home, "$") - 2)

Select Case KolBog
    Case "A" To "F"
      Exit Sub
End Select

Application.ScreenUpdating = False

If Columns("G:XFD").Hidden = True Or Rows(9).Hidden Then GoTo Vis

Columns("G:XFD").Hidden = True

KolBog = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Columns(KolBog).Hidden = False
    For Række = 9 To antrk
    If Range(KolBog & Række) = "" Then
    Rows(Række).Select
    Selection.EntireRow.Hidden = True
    End If
    Next
GoTo skjul
   
Vis:
Columns("G:XFD").Hidden = False
Cells.EntireRow.Hidden = False
Sheets(homeArk).Select
Range(home).Select
skjul:
Application.ScreenUpdating = True
Sheets(homeArk).Select
Range(home).Select
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Makro køres ved dobbelt-klik i cellerne G1, H1 og I1
'tilføj selv flere....
    If Target.Address = "$G$1" Or _
    Target.Address = "$H$1" Or _
    Target.Address = "$I$1" Then
    Target.Offset(1, 0).Activate
 
home = ActiveCell.Address
homeArk = ActiveSheet.Name
antrk = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
KolBog = Mid(home, 2, InStr(2, home, "$") - 2)

Select Case KolBog
    Case "A" To "F"
      Exit Sub
End Select

Application.ScreenUpdating = False

If Columns("G:XFD").Hidden = True Or Rows(9).Hidden Then GoTo Vis

Columns("G:XFD").Hidden = True

KolBog = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Columns(KolBog).Hidden = False
    For Række = 9 To antrk
    If Range(KolBog & Række) = "" Then
    Rows(Række).Select
    Selection.EntireRow.Hidden = True
    End If
    Next
GoTo skjul
   
Vis:
Columns("G:XFD").Hidden = False
Cells.EntireRow.Hidden = False
Sheets(homeArk).Select
Range(home).Select
skjul:
Application.ScreenUpdating = True
Sheets(homeArk).Select
Range(home).Select
    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
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
Automatisk give specifikke point udfra placering Af jernrosen3 i Excel 5 19/12/202410:24 22/12/202413:14
Delvis udfyld en celle, baseret på en %-sats fra anden celle Af Brian Nielsen i Excel 2 16/12/202415:27 17/12/202422:03
Hjælp til formatering af excel ark. Af Nicholas i Excel 23 13/12/202412:32 18/12/202415:44
To x-akser men kun ét datasæt? Af TheLibrarian i Excel 1 10/12/202409:17 10/12/202410:35
Isolere en dato i tekst/tal Af jernrosen3 i Excel 7 09/12/202408:59 09/12/202410:38
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
IT-JOB

Rohde & Schwarz Technology Center A/S

FPGA-udvikler

Udviklings- og Forenklingsstyrelsen

Driftsspecialist til tværfagligt team

Netcompany A/S

Test Specialist

Cognizant Technology Solutions Denmark ApS

Test Manager

Jyske Bank

AI transformation lead
Seneste spørgsmål Seneste aktivitet
I går 16:03 Fjern "Seneste" - "Hurtig adgang" Fra Windows 11 - Hvordan ? Af Ikke-ekspert i Windows
23/1214:43 html <Input.. Danske bogstaver Af pjotre i Andet software
23/1214:35 Brænde musik fra usb drev til cd Af Caso i Andet hardware
21/1222:16 Er "OneDrive" et "Must" ? Koster det penge ? Af Ikke-ekspert i Windows
21/1216:42 Windows Media Player - Hvilken version (Versioner) er gode til at afspille og kopiere ? Af Ikke-ekspert i Musik & videoafspillere
White papers
Flere white papers »


Premium
Teaser billede
Historisk million-bøde får Region Syddanmarks it-direktør til at efterlyse nye GDPR-retningslinjer
Læs mere »
Ser med 'stor alvor' på problemer med vand, varme og manglende kontrol i politiets datacenter
Brugere rammes af Microsoft-fejl: M365-produkter er på mystisk vis blevet deaktiveret
Overblik: Danske it-selskaber strømmer ind mod den centrale storby - og det handler ikke om penge
Se alle »
Computerworld
Teaser billede
Mord på it-profil truer San Franciscos status som tech-mekka: Byen er forvandlet til en zombie-by
Læs mere »
Netværkstest: Første mesh-sæt med komplette WiFi 7-features sætter nye rekorder for dækning og hastighed
Her er dommen: Region Syddanmark skal betale historisk stor bøde for grove overtrædelser af GDPR
Nørgaard: Copilot scorer pænt højt i min kendte 3D-test (Dyrt, Dumt, Dårligt)
Se alle »
CIO
Teaser billede
Dansk headhunter: Dette spørgsmål bliver jeg næsten altid stillet, når jeg forsøger at rekruttere it-folk
Læs mere »
Software-selskabernes prisstigninger får nu danske virksomheder til at søge mod open source
AI er et falmende buzzword: Lad mig fluks dele en god og en dårlig nyhed
En af verdens største it-distributører dropper samarbejdet med Broadcom: Kunne ikke nå til enighed
Se alle »
Job & Karriere
Teaser billede
Microsoft klar med ny direktion for den danske forretning: Her er de nye direktører
Læs mere »
Merete Søby klar med nyt top-job efter pludselig exit fra Schultz: Her er hendes nye job
Linus Torvalds giver russiske Linux-udviklere sparket: Vil ikke have noget med dem at gøre
Dansk headhunter: Dette spørgsmål bliver jeg næsten altid stillet, når jeg forsøger at rekruttere it-folk
Se alle »
White paper
Teaser billede
Sådan: Én løsning til compliance, sikkerhed og overblik
Læs mere »
Sæt turbo på din cloudperformance og minimér risikoen for DDoS-angreb
Governance, Risk & Compliance: Knyt stærke bånd mellem forretning og sikkerhed
Beskyt virksomheden mod trusler – og hold ressourceforbruget nede
Se alle »

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