Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Gliederung anhand Ebenen Nummer | Herbers Excel-Forum


Betrifft: Gliederung anhand Ebenen Nummer von: Gerd
Geschrieben am: 08.01.2012 20:42:44

Hallo,

ich suche eine Lösung (mit oder ohne VBA) eine Excel Liste nach Ebenen zu gliedern, dafür gibt es die erste Spalte Ebene.

Die Datei ist hier zu finden:

https://www.herber.de/bbs/user/78306.xlsx

Ich habe versucht die Baumstruktur in der Spalte "Name eingerückt" zu visualisieren. Ich möchte so gliedern, das ich zunächst nur Ebene 1 sehe (ein Root Element), dann Ebene 2 aufklappen kann, dann 3 etc.

Ist so etwas möglich ?

viele Grüße,
Gerd

  

Betrifft: AW: Gliederung anhand Ebenen Nummer von: fcs
Geschrieben am: 10.01.2012 08:36:31

Hallo Gerd,

hier mein Vorschlag als Makro-Lösung.

Gruß
Franz

'##############################################################
'# Windows Vista  -       Excel 2007    -        VBA 6.5.1053 #
'# fcs                                             2012-01-10 #
'# Modul: Allgemeines Modul                                   #
'# Zeilen abhängig von Zellinhalt einblenden                  #
'# Makros sollten auch unter Excel 2003 lauffähig sein        #
'##############################################################

Private varEbene

Sub EbenenEinblenden()
  'Beschreibung
  'Deklaration von Variablen
  Dim wks As Worksheet, rngAusblenden As Range, lngZeile As Long
  Dim StatusCalc As Long
  On Error GoTo Fehler
  
  Set wks = ActiveSheet
  With wks
    If varEbene = Application.WorksheetFunction.Max(.Columns(1)) Then varEbene = 0
    varEbene = Val(InputBox("Höchste anzuzeigende Ebene:", "Ebenen aublenden", varEbene + 1))
    If varEbene = 0 Then Goto Fehler
    
    'Makrobremsen lösen
    With Application
      .EnableEvents = False
      StatusCalc = .Application.Calculation
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
    End With
    .Rows.Hidden = False
    Set rngAusblenden = Nothing
    For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
      If .Cells(lngZeile, 1) > varEbene Then
        If rngAusblenden Is Nothing Then
          Set rngAusblenden = .Cells(lngZeile, 1)
        Else
          Set rngAusblenden = Application.Union(rngAusblenden, .Cells(lngZeile, 1))
        End If
      End If
    Next
  End With
  If Not rngAusblenden Is Nothing Then
    rngAusblenden.EntireRow.Hidden = True
  End If
'
'Fehlerbehandlung
  Err.Clear
Fehler:
  With Err
    Select Case .Number
      Case 0 'kein Fehler
      Case Else
        MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
    End Select
  End With
'Makrobremsen zurücksetzen
  With Application
    .EnableEvents = True
    .Calculation = StatusCalc
    .ScreenUpdating = True
  End With
'Variablen aufräumen
  Set wks = Nothing: Set rngAusblenden = Nothing 'Objektvariablen zurücksetzen
End Sub



  

Betrifft: AW: Gliederung anhand Ebenen Nummer von: Gerd
Geschrieben am: 10.01.2012 15:58:16

Hallo Franz,

vielen Dank !! Ich dachte ursprünglich man kann die Gliederungsfunktion von Excel auslösen (mit den + Zeichen am Rand), aber ich glaube so kann ich es auch einbauen - funktioniert auf jeden Fall prima und ist auch schnell.

...und ich habe gleich noch was gelernt wie man Makrobremsen löst :-)

Viele Grüße,
Gerd


  

Betrifft: AW: Gliederung anhand Ebenen Nummer von: fcs
Geschrieben am: 10.01.2012 17:56:12

Hallo Gerd,

hier eine Makro-Variante, die entsprechend den Nummern in Spalte A eine Gliederung erstellt.
Diese ist halt etwas komplizierter im logischen Ablauf.

Gruß
Franz

'##############################################################
'# Windows Vista  -       Excel 2007    -        VBA 6.5.1053 #
'# fcs                                             2012-01-10 #
'# Modul: Allgemeines Modul                                   #
'# Gliederungerstellen gemäß nummerischer Werte in Spalte A   #
'# Makros sollten auch unter Excel 2003 lauffähig sein        #
'##############################################################

Sub Gliederungerstellen()
'
  'Deklaration von Variablen
  Dim wks As Worksheet
  Dim lngZeile As Long, lngZeile1 As Long, lngZeile2 As Long
  Dim intEbene As Integer, intEbeneMax As Integer
  Dim StatusCalc As Long
  On Error GoTo Fehler
  
  Set wks = ActiveSheet
  With wks
    
    'Makrobremsen lösen
    With Application
      .EnableEvents = False
      StatusCalc = .Application.Calculation
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
    End With
    'vorhandenen Gliederung löschen
    .Cells.ClearOutline
    'Position der Summenzeilen/-spalten setzen
    With .Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlLeft
    End With
    'Max. Gliederungsstufe in Spalte A
    intEbeneMax = Application.WorksheetFunction.Max(.Columns(1))
    If intEbeneMax = 0 Then GoTo Fehler
    
    For intEbene = 1 To intEbeneMax - 1
      For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(lngZeile, 1) = intEbene Then
          lngZeile1 = lngZeile
          Do
            lngZeile2 = lngZeile
            If .Cells(lngZeile + 1, 1) <= intEbene _
                Or IsEmpty(.Cells(lngZeile + 1, 1)) Then Exit Do
            lngZeile = lngZeile + 1
          Loop
          If lngZeile2 = lngZeile1 Then
            'do nothing
            'Zeile hat gleiche Ebene wie vorherige Zeile
          Else
            lngZeile1 = lngZeile1 + 1
            .Range(.Rows(lngZeile1), .Rows(lngZeile2)).Group
          End If
        End If
      Next
    Next
  End With
'Fehlerbehandlung
  Err.Clear
Fehler:
  With Err
    Select Case .Number
      Case 0 'kein Fehler
      Case Else
        MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
    End Select
  End With
'Makrobremsen zurücksetzen
  With Application
    .EnableEvents = True
    .Calculation = StatusCalc
    .ScreenUpdating = True
  End With
'Variablen aufräumen
  Set wks = Nothing 'Objektvariablen zurücksetzen
End Sub



  

Betrifft: AW: Gliederung anhand Ebenen Nummer von: Gerd
Geschrieben am: 10.01.2012 19:16:22

Hallo Franz,

noch besser !! Wie machst Du das bloß so schnell ?

Ich glaube ich muss bei dir mal eine Schulung buchen :-)

Viele Grüße,
Gerd


Beiträge aus den Excel-Beispielen zum Thema "Gliederung anhand Ebenen Nummer"