VBA Gruppierung

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Gruppierung

16.09.2015 03:17:44

fcs

AW: VBA Gruppierung

16.09.2015 16:56:35

Roffel89

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

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Gruppierung

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread