CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

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?

Synes godt om

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

Synes godt om

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

Synes godt om

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?

Synes godt om

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.

Synes godt om

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.

Synes godt om

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?

Synes godt om

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

Synes godt om

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.

Synes godt om

store-morten Ekspert

23. maj 2012 - 16:09 #9

Hos mig, ingen problem?

Synes godt om

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.

Synes godt om

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

Synes godt om

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.

Synes godt om

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

Synes godt om

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? :)

Synes godt om

store-morten Ekspert

23. maj 2012 - 16:52 #15

Nej

Er det et fast antal rækker?

Synes godt om

store-morten Ekspert

23. maj 2012 - 17:31 #16

Synes godt om

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

Synes godt om

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.

Følg dette spørgsmål

Opret Preview

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
Lopslag Af Luffe i Excel	12	I går 09:22	I dag 12:42
Flextids registrering Af Kenneth Kirsgart i Excel	6	03/07/202416:52	I går 06:53
Kørebog i excel - Funktion/formel Af ivan Vasilevskikh i Excel	2	01/07/202414:27	01/07/202418:11
udfordring med en alm. HVIS formel Af Klaus W i Excel	5	30/06/202415:53	01/07/202411:20
Hent værdi fra celle i et defineret navneområde Af Zigarlos i Excel	7	28/06/202410:16	28/06/202423:18

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.

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten

Seneste artiklerRSS