geht das auch eleganter ?

Hallo Zusammen,
ich habe versucht bestimmte Spalten über die Funktion "Gruppierung" für die Eingaben aufzuklappen bzw. zu schließen. Eine Beispieldatei habe ich hochgeladen:
https://www.herber.de/bbs/user/77784.xls
Frage: da ich die Funktion "Gruppierung" so nicht ansprechen konnte, habe ich das mit "Spalten ausblenden" bzw "einblenden" gemacht - ich denke aber das das auch elagenter geht. Allerdings fehlen mir hierz die Kenntnisse.
In der Beispieldatei sind in Spalte "X" Hinweise, die nur als Infomation in der Entwicklungsdatei sind, Später soll die Funktion auf- zuklappen in weiteren Coede eingebunden werden.
Wenn jemand eine Idee zur Verbesserung hat, freue ich mich über Eure Hilfe.
Viele Grüße
Johannes

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Martin,
ich habe Deinen Vorschlag wie folgt eingebaut:
Sub Daten_neu()
If Range("W3") = 1 Then
'alle Gruppierungen schließen
Range("X4:X9").Value = ""
Range("X4").Value = "Gruppen zu"
Range("E1").Columns.ShowDetail = False
Range("I1").Columns.ShowDetail = False
Range("M1").Columns.ShowDetail = False
Range("Q1").Columns.ShowDetail = False
Range("U1").Columns.ShowDetail = False
Range("W2").Select
ElseIf Range("W3") = 2 Then
'Gruppierung 1 aufklappen
Range("X4:X9").Value = ""
Range("X5").Value = "Gruppe 1 auf"
Range("E1").Columns.ShowDetail = True
Range("I1").Columns.ShowDetail = False
Range("M1").Columns.ShowDetail = False
Range("Q1").Columns.ShowDetail = False
Range("U1").Columns.ShowDetail = False
Range("W2").Select
ElseIf Range("W3") = 3 Then
'Gruppierung 2 aufklappen
Range("X4:X9").Value = ""
Range("X6").Value = "Gruppe 2 auf"
Range("E1").Columns.ShowDetail = False
Range("I1").Columns.ShowDetail = True
Range("M1").Columns.ShowDetail = False
Range("Q1").Columns.ShowDetail = False
Range("U1").Columns.ShowDetail = False
Range("W2").Select
(ist nur ein Auszug ...)
damit geht die eine Gruppe zwar auf, aber die anderen müssen geschlossen werden. Sind diese aber schon geschlossen kommt eine Fehlermeldung.
Gruß
Johannes

Sub Daten_holen() Select Case Range("W3") Case 1 'Alle Zu Range("X4").Value = "Gruppen zu" Range("X5:X9").Value = "" Case 2 To 6 'Falls Wert zw. 2 bis 6 : 'alle Gruppierungen schließen ActiveSheet.Outline.ShowLevels ColumnLevels:=1 Range("X4:X9").Value = "" Range("X4").Offset([W3].Value - 1).Value = "Gruppe " & [W3].Value - 1 & " auf" Range("E1").Offset(0, ([W3].Value - 2) * 4).Columns.ShowDetail = True Range("W2").Select End Select End Sub

Sub Daten_holen() Select Case Range("W3") Case 1 'Alle Zu 'alle Gruppierungen schließen ActiveSheet.Outline.ShowLevels ColumnLevels:=1 Range("X4").Value = "Gruppen zu" Range("X5:X9").Value = "" Case 2 To 6 'Falls Wert zw. 2 bis 6 : 'alle Gruppierungen schließen ActiveSheet.Outline.ShowLevels ColumnLevels:=1 Range("X4:X9").Value = "" Range("X4").Offset([W3].Value - 1).Value = "Gruppe " & [W3].Value - 1 & " auf" Range("E1").Offset(0, ([W3].Value - 2) * 4).Columns.ShowDetail = True Range("W2").Select End Select End Sub

Sub daten_holen() Dim i As Integer, strColumns As String, arrColumns Range("X4:X9") = "" On Error Resume Next For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column Err.Clear Columns(i).ShowDetail = False If Err 0 And Columns(i - 1).OutlineLevel > 1 Then strColumns = strColumns & i & ";" End If Next On Error GoTo 0 strColumns = Left(strColumns, Len(strColumns) - 1) arrColumns = Split(strColumns, ";") i = Range("W3") Select Case i Case 1 Range("X" & i + 3) = "alle zu" Case Else ActiveSheet.Columns(arrColumns(i - 2) * 1).ShowDetail = True Range("X" & i + 3) = "Gruppe " & i - 1 & " auf" End Select End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread