Microsoft Excel

Herbers Excel/VBA-Archiv

Auto-Gruppierung

Betrifft: Auto-Gruppierung von: Holger
Geschrieben am: 15.11.2014 01:11:00

Hallo,

ich würde gerne eine Gruppierung per VBA automatisieren, die z.B. an bestimmte "Zeichen" gebunden ist.

Bsp:
Gliederungstufe
3 wenn in Zelle A1 "*"
3 wenn in Zelle B1 "*"
2 wenn in Zelle C1 "**"
3 wenn in Zelle D1 "*"
3 wenn in Zelle E1 "*"
2 wenn in Zelle F1 "**"
1 wenn in Zelle G1 "***"
...

Hoffe es ist verständlich, bin für jegliche Hilfestellung dankbar.

Gruß
Holger

  

Betrifft: AW: Auto-Gruppierung von: fcs
Geschrieben am: 17.11.2014 13:02:17

Hallo Holger,

hier ein entsprechendes Makro zur Gliederung von Spalten.

Gruß
Franz

Sub Gliederung_Spalten()
  Dim intLevel As Integer, Spalte As Long, wks As Worksheet, SpalteL As Long
  Dim bolRechts As Boolean
  'Hauptspaltenn in der Gliederung
  bolRechts = False 'True = rechts, False = links
  Set wks = ActiveSheet
  With wks
    .Columns.ClearOutline
    If bolRechts = True Then
      .Outline.SummaryColumn = xlSummaryOnRight
    Else
      .Outline.SummaryColumn = xlSummaryOnLeft
    End If
    SpalteL = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For Spalte = IIf(bolRechts, 1, SpalteL) To IIf(bolRechts, SpalteL, 1) _
          Step IIf(bolRechts, 1, -1)
      Select Case .Cells(1, Spalte).Text
        Case "***": intLevel = 1
        Case "**": intLevel = 2
        Case "*": intLevel = 3
        Case Else
          intLevel = 0
      End Select
      If intLevel > 0 Then
        .Columns(Spalte).OutlineLevel = intLevel
      End If
    Next
  End With
End Sub