Hallo, kann ich folgenden Code verkürzen?
Programm funktioniert zwar, aber excel hängt ständig sobald ich was eintippe
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [g31].Value = 0 Then
Rows("31:60").EntireRow.Hidden = True
Else
Rows("31:60").EntireRow.Hidden = False
End If
If [g61].Value = 0 Then
Rows("61:90").EntireRow.Hidden = True
Else
Rows("61:90").EntireRow.Hidden = False
End If
If [g91].Value = 0 Then
Rows("91:120").EntireRow.Hidden = True
Else
Rows("91:120").EntireRow.Hidden = False
End If
If [g121].Value = 0 Then
Rows("121:150").EntireRow.Hidden = True
Else
Rows("121:150").EntireRow.Hidden = False
End If
If [g151].Value = 0 Then
Rows("151:180").EntireRow.Hidden = True
Else
Rows("151:180").EntireRow.Hidden = False
End If
If [g181].Value = 0 Then
Rows("181:210").EntireRow.Hidden = True
Else
Rows("181:210").EntireRow.Hidden = False
End If
If [g211].Value = 0 Then
Rows("211:240").EntireRow.Hidden = True
Else
Rows("211:240").EntireRow.Hidden = False
End If
If [g241].Value = 0 Then
Rows("241:270").EntireRow.Hidden = True
Else
Rows("241:270").EntireRow.Hidden = False
End If
If [g271].Value = 0 Then
Rows("271:300").EntireRow.Hidden = True
Else
Rows("271:300").EntireRow.Hidden = False
End If
If [g301].Value = 0 Then
Rows("301:330").EntireRow.Hidden = True
Else
Rows("301:330").EntireRow.Hidden = False
End If
If [g331].Value = 0 Then
Rows("331:360").EntireRow.Hidden = True
Else
Rows("331:360").EntireRow.Hidden = False
End If
If [g361].Value = 0 Then
Rows("361:390").EntireRow.Hidden = True
Else
Rows("361:390").EntireRow.Hidden = False
End If
If [g391].Value = 0 Then
Rows("391:420").EntireRow.Hidden = True
Else
Rows("391:420").EntireRow.Hidden = False
End If
If [g421].Value = 0 Then
Rows("421:450").EntireRow.Hidden = True
Else
Rows("421:450").EntireRow.Hidden = False
End If
If [g451].Value = 0 Then
Rows("451:480").EntireRow.Hidden = True
Else
Rows("451:480").EntireRow.Hidden = False
End If
If [g481].Value = 0 Then
Rows("481:510").EntireRow.Hidden = True
Else
Rows("481:510").EntireRow.Hidden = False
End If
If [g511].Value = 0 Then
Rows("511:540").EntireRow.Hidden = True
Else
Rows("511:540").EntireRow.Hidden = False
End If
If [g541].Value = 0 Then
Rows("541:570").EntireRow.Hidden = True
Else
Rows("541:570").EntireRow.Hidden = False
End If
If [g571].Value = 0 Then
Rows("571:600").EntireRow.Hidden = True
Else
Rows("571:600").EntireRow.Hidden = False
End If
If [g601].Value = 0 Then
Rows("601:630").EntireRow.Hidden = True
Else
Rows("601:630").EntireRow.Hidden = False
End If
If [g631].Value = 0 Then
Rows("631:660").EntireRow.Hidden = True
Else
Rows("631:660").EntireRow.Hidden = False
End If
If [g661].Value = 0 Then
Rows("661:690").EntireRow.Hidden = True
Else
Rows("661:690").EntireRow.Hidden = False
End If
If [g691].Value = 0 Then
Rows("691:720").EntireRow.Hidden = True
Else
Rows("691:720").EntireRow.Hidden = False
End If
If [g721].Value = 0 Then
Rows("721:750").EntireRow.Hidden = True
Else
Rows("721:750").EntireRow.Hidden = False
End If
If [g751].Value = 0 Then
Rows("751:780").EntireRow.Hidden = True
Else
Rows("751:780").EntireRow.Hidden = False
End If
If [g781].Value = 0 Then
Rows("781:810").EntireRow.Hidden = True
Else
Rows("781:810").EntireRow.Hidden = False
End If
If [g810].Value = 0 Then
Rows("811:840").EntireRow.Hidden = True
Else
Rows("811:840").EntireRow.Hidden = False
End If
End Sub
Danke
LG
|