Skjul rækker/kolonner med Excel VBA-makroer
Et ofte stillet spørgsmål er, hvordan man skjuler rækker og/eller kolonner i Excel med en VBA makro, hvis den og den betingelse er opfyldt.
På denne side viser jeg eksempler på, hvad man kan gøre. VBA-koden kan du markere med musen, kopiere med CTRL+C og indsætte i et VBA-modul med CTRL+V. Du kan også downloade et zip-komprimeret regneark med eksemplerne. For at pakke det ud kan du højreklikke og vælge "Udpak alle...", eller hvad Windows nu foreslår.
Der er grundliggende to forskellige metoder, man kan bruge. Man kan gøre det "automatisk" ved at lægge kode ind i fanebladets WorkSheet_Change procedure, som aktiveres, hver gang der sker en ændring i et eller andet på fanebladet - fx hvis der indsættes eller slettes noget i en celle.
Den anden vinkel er at køre en "almindelig" makro, som undersøger, om visse betingelser er opfyldt. Lad os starte med den sidste metode.
Det første eksempel viser, hvordan man kan skjule tomme kolonner, og det næste hvordan man kan bruge søgefunktionen og skjule rækker, hvis en bestemt værdi findes i et givet område.
Før vi går i gang med at gemme og skjule, vil jeg dog lige vise, hvordan man kan få de skjulte rækker og kolonner frem igen!
Sub VisSkjulte()
Rows.Hidden = False
Columns.Hidden = False
End Sub
Skjul tomme kolonner
Dette er et ret enkelt eksempel på, hvordan man kan skjule tomme kolonner i et område - her kolonne 1 til 26.
Sub SkjulTommeKolonner()
Dim rCell As Range
Dim rTest As Range
Dim lCol As Long
On Error GoTo Fejl
Application.ScreenUpdating = False
For lCol = 0 To 25 Step 1
Set rCell = Range("A1").Offset(0, lCol)
If Len(rCell.Value) = 0 Then
Set rTest = rCell.End(xlDown)
If rTest.Row = Rows.Count And Len(rTest.Value) = 0 Then
Columns(rCell.Column).Hidden = True
End If
End If
Next
BeforeExit:
Set rCell = Nothing
Set rTest = Nothing
Application.ScreenUpdating = True
Exit Sub
Fejl:
MsgBox Err.Description & " Procedure SkjulTommeKolonner"
Resume BeforeExit
End Sub
Brug af søgefunktionen
Det følgende eksempel gør brug af Excels søgefunktion i et afgrænset område - her kolonne B, men det kan let ændres.
Vi beder brugeren fortælle, hvad der skal søges efter, og en række skjules, hvis søgeværdien optræder i kolonne B. Bemærk at "?" og "*" kan bruges som wildcards eller "jokertegn".
Sub FindSkjul()
Dim vFind
Dim rSearch As Range
On Error GoTo ErrorHandle
vFind = InputBox("Skriv, hvad der skal søges efter.")
If Len(vFind) = 0 Then Exit Sub
Application.ScreenUpdating = False
With Columns("B:B")
Set rSearch = .Find(vFind, LookIn:=xlValues)
If Not rSearch Is Nothing Then
rSearch.EntireRow.Hidden = True
Do
Set rSearch = .FindNext(rSearch)
If Not rSearch Is Nothing Then
rSearch.EntireRow.Hidden = True
Else
Exit Do
End If
Loop
End If
End With
BeforeExit:
Set rSearch = Nothing
Application.ScreenUpdating = True
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure FindSkjul"
Resume BeforeExit
End Sub
Automatisk kode
De næste to makroer er eksempler på det, jeg har valgt at kalde "automatisk kode," fordi makroerne køres automatisk, hvis en bestemt betingelse er opfyldt. Man skal altså ikke gøre noget aktivt à la trykke på en trykknap eller lignende for at eksekvere koden.
Det kan man gøre ved at lægge VBA-kode ind i fanebladets/arkets eget kodeblad. Her kan "events" (hændelser) automatisk udløse, at VBA-kode køres.
Konkret benytter vi os af standardproceduren Worksheet_Change, som automatisk kaldes, når der sker en ændring i fanebladet/arket. Hvis du ikke kan se fanebladenes kodeark i VBA-editoren, kan du taste CTRL+R for at åbne vinduet med Project Explorer:
De følgende Worksheet_Change procedurer skal ligge i fanebladets kodeark for at virke.
Det første eksempel er såre enkelt: Hvis man indsætter et "x" i kolonne A, vil den pågældende række blive skjult. Hvis man indsætter et 0 (nul), vil alle skjulte rækker blive vist igen, og gamle indtastninger i kolonne A slettes.
I det sidste eksempel kan man indtaste noget i celle A1, og alle rækker (undtaget række 1), som indeholder samme værdi i kolonne A vil blive skjult.
Det er ikke ulig eksemplet, hvor vi brugte søgefunktionen, blot bruger vi her gennemløb af cellerne i stedet.
Skjul rækker med x
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
With Target
If .Column <> 1 Then
Exit Sub
Else
If .Value = "x" Then
.EntireRow.Hidden = True
End If
If .Value = 0 And Len(.Value) > 0 Then
Application.EnableEvents = False
Rows.Hidden = False
Columns(1).Clear
Application.EnableEvents = True
End If
End If
End With
End Sub
Skjul rækker med kriterium
Det sidste eksempel viser, hvordan man kan skjule alle rækker, som i kolonne A har samme indhold som celle A1.
Det hele kunne sådan set godt skrives i fanebladets Worksheet_Change procedure, men for eksemplets skyld har jeg valgt, at Worksheet_Change proceduren kalder en "normal" procedure/makro til at udføre noget af arbejdet.
Worksheet_Change proceduren skal altså indsættes i fanebladets kodeark, mens proceduren SkjulMedKriterie skal indsættes i et modul.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandle
If Target <> Range("A1") Then
Exit Sub
Else
Application.ScreenUpdating = False
If Target.Value = 0 Then
ActiveSheet.Rows.Hidden = False
ElseIf Len(Target.Value) > 0 Then
Application.EnableEvents = False
SkjulMedKriterie Target.Value
Application.EnableEvents = True
End If
End If
BeforeExit:
Application.ScreenUpdating = True
Range("A1").Activate
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Worksheet_Change"
Resume BeforeExit
End Sub
Den følgende procedure indsættes i et almindeligt modul.
Sub SkjulMedKriterie(ByVal sXY As String)
Dim rCell As Range
Dim rRange As Range
On Error GoTo ErrorHandle
Set rCell = Range("A65536")
If rCell.Value = sXY Then
rCell.EntireRow.Hidden = True
End If
Set rCell = rCell.End(xlUp)
If rCell.Row = 1 Then GoTo BeforeExit
Set rRange = Range(rCell, Range("A2"))
For Each rCell In rRange
If rCell.Value = sXY Then
rCell.EntireRow.Hidden = True
End If
Next
BeforeExit:
Set rCell = Nothing
Set rRange = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure SkjulMedKriterie"
Resume BeforeExit
End Sub
Det var det. Som nævnt øverst på siden kan du downloade et zip-komprimeret regneark med eksemplerne.
Relateret:
|