Ausblenden verschiederner Zeilen mit VBA

Forumthread: Ausblenden verschiederner Zeilen mit VBA

24.08.2015 03:39:30

Ulle

Hallo, ich möchte gern das wenn in Q3 nichts steht verschiedene Zeilen ausgeblendet werden. Diese Abfrage soll auch für AD3 gelten aber mit anderen Zeilen.
ich habe folgenden code schon zusammen, aber die Berechnung dauert zu lange :-(


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(8).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(12).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(16).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(20).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(24).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(28).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(32).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(36).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(40).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(44).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(48).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(52).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("Q3")) Is Nothing Then Rows(56).Hidden = IsEmpty(Range("Q3"))
If Not Intersect(Target, Range("AD3")) Is Nothing Then Rows(9).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(13).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(17).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(21).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(25).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(29).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(33).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(37).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(41).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(45).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(49).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(53).Hidden = IsEmpty(Range("ad3"))
If Not Intersect(Target, Range("ad3")) Is Nothing Then Rows(57).Hidden = IsEmpty(Range("ad3"))
End Sub

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ausblenden verschiederner Zeilen mit VBA

24.08.2015 08:00:50

hary
AW: Ausblenden verschiederner Zeilen mit VBA

24.08.2015 08:12:39

Gerd
Systematik

24.08.2015 09:00:15

RPP63
AW: Systematik

26.08.2015 12:47:26

Ulle
AW: Systematik

27.08.2015 12:02:38

Ulle

AW: Ausblenden verschiederner Zeilen mit VBA

24.08.2015 08:00:50

hary

Moin
Eine Moeglichkeit.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Q3", "AD3")) Is Nothing Then
Select Case Target.Address(False, False)
Case "Q3"
Rows(8).Hidden = IsEmpty(Target)
Rows(12).Hidden = IsEmpty(Target)
Rows(16).Hidden = IsEmpty(Target)
Rows(20).Hidden = IsEmpty(Target)
Rows(24).Hidden = IsEmpty(Target)
Rows(28).Hidden = IsEmpty(Target)
Rows(32).Hidden = IsEmpty(Target)
Rows(36).Hidden = IsEmpty(Target)
Rows(40).Hidden = IsEmpty(Target)
Rows(44).Hidden = IsEmpty(Target)
Rows(48).Hidden = IsEmpty(Target)
Rows(52).Hidden = IsEmpty(Target)
Rows(56).Hidden = IsEmpty(Target)
Case "AD3"
Rows(9).Hidden = IsEmpty(Target)
Rows(13).Hidden = IsEmpty(Target)
Rows(17).Hidden = IsEmpty(Target)
Rows(21).Hidden = IsEmpty(Target)
Rows(25).Hidden = IsEmpty(Target)
Rows(29).Hidden = IsEmpty(Target)
Rows(33).Hidden = IsEmpty(Target)
Rows(37).Hidden = IsEmpty(Target)
Rows(41).Hidden = IsEmpty(Target)
Rows(45).Hidden = IsEmpty(Target)
Rows(49).Hidden = IsEmpty(Target)
Rows(53).Hidden = IsEmpty(Target)
Rows(57).Hidden = IsEmpty(Target)
End Select
End If
End Sub

gruss hary

AW: Ausblenden verschiederner Zeilen mit VBA

24.08.2015 08:12:39

Gerd

Hallo Ulle,
noch eine andere - nur bei Änderungen in den beiden Bezugszellen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$Q$3" Or Target.Address = "$AD$3" Then
Range("8:8,12:12,16:16,20:20,24:24,28:28,32:32,36:36,40:40,44:44,48:48,52:52,56:56").EntireRow. _
Hidden = IsEmpty(Range("Q3"))
Range("9:9,13:13,17:17,21:21,25:25,29:29,33:33,37:37,41:41,45:45,49:49,53:53,57:57").EntireRow. _
Hidden = IsEmpty(Range("AD3"))
End If
End Sub

Gruß Gerd

Systematik

24.08.2015 09:00:15

RPP63

Hallo!
Da hier eine "schöne" Systematik besteht, sollte man sie auch ausnutzen:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Q3", "AD3")) Is Nothing Then
Select Case Target.Address(False, False)
Case "Q3": ZeilenEinAus 8, Target
Case "AD3": ZeilenEinAus 9, Target
End Select
End If
End Sub
Private Sub ZeilenEinAus(Start As Long, Zelle As Range)
Dim Zeile As Long
Application.ScreenUpdating = False
For Zeile = Start To Start + 48 Step 4
Rows(Zeile).Hidden = IsEmpty(Zelle)
Next
End Sub

Gruß Ralf

AW: Systematik

26.08.2015 12:47:26

Ulle

Hi erst einmal vielen Dank für eure schnellen Antwort, sry das ich heut erst antworte aber habe die Datei auf Arbeit.
Harry und Gerd L, ich habe eure Code´s auch ausprobiert und die erfüllen natürlich auch das gefordert, Danke.
Aber der Code von RPP63 ist schneller mit aus und einblenden :-) Vielen Dank

AW: Systematik

27.08.2015 12:02:38

Ulle

Hi Ralf, ich hoffe du kannst mir noch einmal helfen.
Ich habe die Liste um ein paar mehr Zellenabfragen erweitern müssen.
Leider bringt er mir nun eine Fehlermeldung:
"Falsche Anzahl an Argumenten oder ungültige Zuweisung"
Ich hoffe du bzw ihr könnt mir helfen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("g1", "J1", "g3", "J3", "P3", "M3", "T3", "W3", "Z3", "G4", "J4", _
"M4", "P4", "T4", "W4", "Z4", "AD4")) Is Nothing Then
Select Case Target.Address(False, False)
Case "g1": ZeilenEinAus 8, Target
Case "j1": ZeilenEinAus 8, Target
Case "g3": ZeilenEinAus 9, Target
Case "j3": ZeilenEinAus 10, Target
Case "m3": ZeilenEinAus 11, Target
Case "p3": ZeilenEinAus 12, Target
Case "t3": ZeilenEinAus 13, Target
Case "w3": ZeilenEinAus 14, Target
Case "z3": ZeilenEinAus 15, Target
Case "g4": ZeilenEinAus 16, Target
Case "j4": ZeilenEinAus 17, Target
Case "m4": ZeilenEinAus 18, Target
Case "p4": ZeilenEinAus 19, Target
Case "t4": ZeilenEinAus 20, Target
Case "w4": ZeilenEinAus 21, Target
Case "z4": ZeilenEinAus 22, Target
Case "ad1": ZeilenEinAus 23, Target
End Select
End If
End Sub

Private Sub ZeilenEinAus(Start As Long, Zelle As Range)
Dim Zeile As Long
Application.ScreenUpdating = False
For Zeile = Start To Start + 230 Step 17
Rows(Zeile).Hidden = IsEmpty(Zelle)
Next
End Sub

Beliebteste Forumthreads (12 Monate)

Ausblenden verschiederner Zeilen mit VBA

Forumthread: Ausblenden verschiederner Zeilen mit VBA

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread