Microsoft Excel

Herbers Excel/VBA-Archiv

Für mich nur kompliziert? -Gruppierung gesucht



Excel-Version: 9.0 (Office 2000)

Betrifft: Für mich nur kompliziert? -Gruppierung gesucht
von: gega
Geschrieben am: 28.05.2002 - 09:09:05

Hallo Profi-Gemeinde,
kann mir jemand wenigstens ansatzweise in diesem Forum bei folgendem Problem weiterhelfen?
Ich habe zwei gleich aufgebaute Tabellen in einer Arbeitsmappe nebeneinander ohne Überschriften.

Tab.1 von SpA bis SpJ
Tab.2 von SpL bis SpU

Schlüsselfelder sind die SpB und SpM nach denen gruppiert werden soll.
Ursprung:

SpA SpB SpC SpD SpE SpF SpG SpH SpI SpJ SpK SpL SpM SpN.....
.........A.................................................................A
.........A.................................................................A
.........A.................................................................B
.........B.................................................................C
.........B.................................................................C
.........C.................................................................D
.........D.................................................................D
.........D.................................................................E
.........D.................................................................E
.........E
usw

so ist die gewünschte Ansicht(nach Gruppierung Leerzeile)?

SpA SpB SpC SpD SpE SpF SpG SpH SpI SpJ SpK SpL SpM SpN.....
.........A.................................................................A
.........A.................................................................A
.........A..................................................................

.........B.................................................................B
.........B...................................................................

.........C.................................................................C
............................................................................C

.........D.................................................................D
.........D.................................................................D
.........D..................................................................

.........E.................................................................E
............................................................................E
usw.

Es sieht so einfach aus und ist dennoch so schwer zu bewerkstelligen -ich jedenfalls bekomme es nicht gebacken.

Gruß gega

  

Re: Für mich nur kompliziert? -Gruppierung gesucht
von: Heinz Ulm
Geschrieben am: 28.05.2002 - 12:28:24

Hallo Gega,

probiere es mal über DATEN - Konsolidieren.
Ich denke, dies wäre eine Möglichkeit.

Gruß Heinz


  

Re: Für mich nur kompliziert? -Gruppierung gesucht
von: Coach
Geschrieben am: 28.05.2002 - 12:44:29

Hallo gega,

mit folgender Procedure funktioniert es (sofern Spalte K leer ist, sonst müßte man vor dem Sortieren entsprechend selektieren):
Sub CustomSort()
Dim IstZeile, IstSpalte As Long
Application.ScreenUpdating = False
Range("B2").Select
Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("M2").Select
Selection.Sort Key1:=Range("M3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
IstZeile = 2
IstSpalte = 2
While (Cells(IstZeile, 2) <> vbNullString) And (Cells(IstZeile, 13) <> vbNullString)
Debug.Print IstZeile, MaxZeile
If (Cells(IstZeile, 2) < Cells(IstZeile, 13)) Then
Range("L1:U1").Offset(IstZeile - 1, 0).Insert Shift:=xlDown
IstSpalte = 2
ElseIf (Cells(IstZeile, 2) > Cells(IstZeile, 13)) Then
Range("A1:J1").Offset(IstZeile - 1, 0).Insert Shift:=xlDown
IstSpalte = 13
End If
If (Cells(IstZeile, IstSpalte) <> vbNullString) And (Cells(IstZeile, IstSpalte) > Cells(IstZeile - 1, IstSpalte)) Then
Range("A1:U1").Offset(IstZeile - 1, 0).Insert Shift:=xlDown
IstZeile = IstZeile + 1
End If
IstZeile = IstZeile + 1
Wend
Application.ScreenUpdating = True
End Sub

Viele Grüße

Coach

PS: Bei Wunsch schicke ich Dir die Beispielmappe.

  

Re: wenn ich nur auch schon so weit wäre
von: gega
Geschrieben am: 28.05.2002 - 20:33:16

Hallo coach,
echt super, habe dein Makro soeben getestet. Es funktioniert bestens. Profiarbeit!! Vielen Dank. Naturlich verstehe ich trotz debuggen nur einen Bruchteil davon. Aber jeder fängt mal klein an.Darf ich noch was fragen. Wie bekomme ich in den jeweiligen Leerzeilen eine Summenbildung von Sp G und Sp R mit Anzeige der Anzahl Datensätze in Sp F und Sp Q. Bis jetzt habe ich ähnliches mit der Pivottabelle abgearbeitet, mit dem Nachteil, dass der Tabellencharakter weg war.

Was meinst du mit der Beispielmappe ?
Gruß und schönen Abend
gega
EMAIL: gabi.bucher@t-online.de

  

Re: wenn ich nur auch schon so weit wäre
von: Coach
Geschrieben am: 29.05.2002 - 11:17:58

Hallo Gabi,

dafür folgende Makro's verwenden ("fettet" die Summenzeilen außerdem noch ein):

Option Explicit
Dim LastZeile, IstZeile, IstSpalte As Long
Sub AggSort()
Cells(IstZeile, 6) = WorksheetFunction.CountA(Range(Cells(LastZeile, 6), Cells(IstZeile - 1, 6)))
Cells(IstZeile, 7) = WorksheetFunction.Sum(Range(Cells(LastZeile, 7), Cells(IstZeile - 1, 7)))
Cells(IstZeile, 17) = WorksheetFunction.CountA(Range(Cells(LastZeile, 17), Cells(IstZeile - 1, 17)))
Cells(IstZeile, 18) = WorksheetFunction.Sum(Range(Cells(LastZeile, 18), Cells(IstZeile - 1, 18)))
Range("A1:U1").Offset(IstZeile - 1, 0).Font.Bold = True
LastZeile = IstZeile + 1
End Sub
Sub CustomSortSum()
Application.ScreenUpdating = False
Range("B2").Select
Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("M2").Select
Selection.Sort Key1:=Range("M3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
IstZeile = 2
IstSpalte = 2
LastZeile = 2
While (Cells(IstZeile, 2) <> vbNullString) And (Cells(IstZeile, 13) <> vbNullString)
If (Cells(IstZeile, 2) < Cells(IstZeile, 13)) Then
Range("L1:U1").Offset(IstZeile - 1, 0).Insert Shift:=xlDown
IstSpalte = 2
ElseIf (Cells(IstZeile, 2) > Cells(IstZeile, 13)) Then
Range("A1:J1").Offset(IstZeile - 1, 0).Insert Shift:=xlDown
IstSpalte = 13
End If
If (Cells(IstZeile, IstSpalte) <> vbNullString) And (Cells(IstZeile, IstSpalte) > Cells(IstZeile - 1, IstSpalte)) Then
Range("A1:U1").Offset(IstZeile - 1, 0).Insert Shift:=xlDown
Call AggSort
IstZeile = IstZeile + 1
End If
IstZeile = IstZeile + 1
Wend
IstZeile = ActiveSheet.UsedRange.Rows.Count + 1
Call AggSort
Application.ScreenUpdating = True
End Sub

Die Beispielmappe (also mein Testexemplar) schicke ich an die angegebene Adresse.

Viele Grüße

Coach

  

S u p e r !! danke o.T.
von: gega
Geschrieben am: 29.05.2002 - 20:12:58

.