VBA Gruppierung

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Label
Bild

Betrifft: VBA Gruppierung
von: Roffel89
Geschrieben am: 15.09.2015 15:34:19

Hallo zusammen,
ich würde gerne eine bestimmte Gruppierung durchführen.
Hier meine zwei Tabellenblätter
Die Summary, in der gearbeitet wird:
Userbild
und mein Datensatz im Tabellenblatt: 30112015
Userbild
und hier mein Code:


Public Sub testClient()
    Dim sheet As String
    'sheet selector
    sheet = "30112015"
    
    
    'Summary Zeile mit Datum und Anzahl der Datensätze
    Dim summary As Integer
    
    summary = checkList(sheet, 13, "Fall 4: Statusveränderung negativ")
    summary = summary + checkList(sheet, 12, "Fall 3: Statusveränderung positiv")
    summary = summary + checkList(sheet, 11, "Fall 2: Keine Statusveränderung (negativ)")
    summary = summary + checkList(sheet, 10, "Fall 1: Keine Statusveränderung (positiv)")
    
    Call newLineAndFormat
    Sheets("Summary").Cells(15, 2).Value = "=TODAY()"
    Sheets("Summary").Cells(15, 5).Value = summary
    Sheets("Summary").Activate
    
    
End Sub
Function checkList(sheet As String, caseColumn As Integer, Optional label As String = "") As Integer
Dim currentRow As Long
Dim counter As Integer

'Checking List
For currentRow = Sheets(sheet).Cells.SpecialCells(xlLastCell).Column To 2 Step -1
If (Sheets(sheet).Cells(currentRow, caseColumn).Value = "True" Or _
Sheets(sheet).Cells(currentRow, caseColumn).Value = "Wahr") Then
Call newLineAndFormat
Sheets("Summary").Cells(15, 4).Value = Sheets(sheet).Cells(currentRow, 1).Value
counter = counter + 1
End If
Next currentRow

'Summary row
Call newLineAndFormat
Sheets("Summary").Cells(15, 4).Value = label
Sheets("Summary").Cells(15, 5).Value = counter
Sheets("Summary").Activate
checkList = counter

End Function
Private Sub newLineAndFormat()
    Sheets("Summary").Activate
    Sheets("Summary").Rows("15:15").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Summary").Range("16:16").Copy
    Sheets("Summary").Rows("15:15").PasteSpecial Paste:=xlPasteFormats
    Sheets("Summary").Range("B15").Select
    Application.CutCopyMode = False
End Sub


Und jetzt ist mein Ziel: das er Fall 3 und Fall 4, die Namen unten den Fallen gruppiert. Das man diese bei Bedarf auf und zuklappen kann.
Und eine Gruppierung über alle 4 Fälle hinweg, sodas man nur meine Summary Zeile sieht.
Wie gehe ich hier vor?
Bin über jede Hilfe dankbar.
VG

Bild

Betrifft: AW: VBA Gruppierung
von: fcs
Geschrieben am: 16.09.2015 03:17:44
Hallo Roffel89,
hier ein Makro zum Erstellen der Gruppierung.
Du musst es starten nach dem Einfügen der Summenzeile.
Gruß
Franz

Sub Gruppieren()
'
    Dim wks As Worksheet
    Dim Zeile As Long, Zeile1 As Long, Zeile2 As Long, ZeileS As Long, ZeileL As Long
    
    Set wks = ActiveWorkbook.Sheets("Summary")
    Application.ScreenUpdating = False
    With wks
        .Activate
        ZeileS = 15 'Startzeile (Zeile mit Datum)
        'Letzte Zeile mit Daten in Spalte D
        ZeileL = .Cells(ZeileS + 1, 4).End(xlDown).Row
        If ZeileL = .Rows.Count Then
            'keine Daten oder nur eine Datenzeile nach Zeile 15
            GoTo Beenden
        End If
        'Gliederung einrichten
        .UsedRange.Rows.ClearOutline
        With .Outline
            .AutomaticStyles = False
            .SummaryRow = xlAbove
            .SummaryColumn = xlLeft
        End With
        'alle Detaildaten gruppieren
        .Range(.Rows(ZeileS + 1), .Rows(ZeileL)).Group
        'Fall 3 und 4 gruppieren
        Zeile1 = 0
        For Zeile = ZeileS To ZeileL
            Select Case Left(.Cells(Zeile, 4).Text, 7)
                Case "Fall 3:"
                    Zeile1 = Zeile
                Case "Fall 4:"
                    If Zeile1 > 0 Then
                        'Namen Fall 3 gruppieren
                        If Zeile2 > Zeile1 Then
                            .Range(.Rows(Zeile1 + 1), .Rows(Zeile2)).Group
                        End If
                    End If
                    Zeile1 = Zeile
            End Select
            Zeile2 = Zeile
            If Zeile = ZeileL Then
                If Zeile1 > 0 Then
                    'Namen Fall 4 gruppieren
                    If Zeile2 > Zeile1 Then
                        .Range(.Rows(Zeile1 + 1), .Rows(Zeile2)).Group
                    End If
                End If
            End If
        Next
    End With
Beenden:
    Application.ScreenUpdating = True
End Sub


Bild

Betrifft: AW: VBA Gruppierung
von: Roffel89
Geschrieben am: 16.09.2015 16:56:35
Vielen Dank Franz.
Ich teste das gleich mal :)
VG

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Gefilterte Tabelle per PDF und variabler Name"