Hallo zusammen,
ich habe mit folgendes "zusammengebastelt"
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False ' Zeilen 41 42 ausblenden
If Not Intersect(Target, Range("B39:X40")) Is Nothing Then
Rows("41:42").Hidden = WorksheetFunction.CountA(Range("B39:X40")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 39 40 ausblenden
If Not Intersect(Target, Range("B37:X38")) Is Nothing Then
Rows("39:40").Hidden = WorksheetFunction.CountA(Range("B37:X38")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 37 38 ausblenden
If Not Intersect(Target, Range("B35:X36")) Is Nothing Then
Rows("37:38").Hidden = WorksheetFunction.CountA(Range("B35:X36")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 35 36 ausblenden
If Not Intersect(Target, Range("B33:X34")) Is Nothing Then
Rows("35:36").Hidden = WorksheetFunction.CountA(Range("B33:X34")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 33 34 ausblenden
If Not Intersect(Target, Range("B31:X32")) Is Nothing Then
Rows("33:34").Hidden = WorksheetFunction.CountA(Range("B31:X32")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 31 32 ausblenden
If Not Intersect(Target, Range("B29:X30")) Is Nothing Then
Rows("31:32").Hidden = WorksheetFunction.CountA(Range("B29:X30")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 29 30 ausblenden
If Not Intersect(Target, Range("B27:X28")) Is Nothing Then
Rows("29:30").Hidden = WorksheetFunction.CountA(Range("B27:X28")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 27 28 ausblenden
If Not Intersect(Target, Range("B25:X26")) Is Nothing Then
Rows("27:28").Hidden = WorksheetFunction.CountA(Range("B25:X26")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 25 26 ausblenden
If Not Intersect(Target, Range("B23:X24")) Is Nothing Then
Rows("25:26").Hidden = WorksheetFunction.CountA(Range("B23:X24")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 23 24 ausblenden
If Not Intersect(Target, Range("B21:X22")) Is Nothing Then
Rows("23:24").Hidden = WorksheetFunction.CountA(Range("B21:X22")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 21 22 ausblenden
If Not Intersect(Target, Range("B19:X20")) Is Nothing Then
Rows("21:22").Hidden = WorksheetFunction.CountA(Range("B19:X20")) = 0
End If
Application.ScreenUpdating = True
Application.ScreenUpdating = False ' Zeilen 19 20 ausblenden
If Not Intersect(Target, Range("B17:X18")) Is Nothing Then
Rows("19:20").Hidden = WorksheetFunction.CountA(Range("B17:X18")) = 0
End If
Application.ScreenUpdating = True
......................
Leider funktioniert das nicht so, wie ich mir das vorgestellt habe.
Die Zeilen werden nicht immer ordentlich ausgeblendet.
Man muß immer in die Zeilen klicken
Alles sehr kackelig und nicht flüssig.
Hat da jemand eine Idee, was ich machen kann.
Lieben Dank bereits im Voraus.