Zwischensummen einfügen per VBA

Hallo Forum,
folgende Nuss will ich knacken...
Gegeben sind folgende variablen Ausgangslagen:

	A	B	C	D	E	F	G
28	LOS	01	xxx
29	TI	01.01	xxx
30	POS	01.01.01	xxx	33,000	m²	186,46	6.153,18
31	EPOS	01.01.02	xxx	44,000	m²	5,81	255,64
32	HP	01.01.03	xxx	1,000	psch.	2.357,74	2.357,74
33	HPEPOS	01.01.04	xxx	1,000	psch.	1.546,71	1.546,71
34	POS	01.01.05	xxx	245,000	m²	48,93	11.987,85
35	POS	01.01.06	xxx	56,000	m²	31,30	1.752,80
36	POS	01.01.07	xxx	44,000	m²	39,02	1.716,88
37	TI	01.02	xxx
38	POS	01.02.01	xxx	233,000	m²	15,77	3.674,41
39	POS	01.02.02	xxx	34,000	m²	10,56	359,04
40	POS	01.02.03	xxx	5,000	Stk	8,71	43,55
41	LOS	02	xxx
42	TI	02.01	xxx
43	POS	02.01.01	xxx	44,000	m	41,93	1.844,92
44	POS	02.01.02	xxx	56,000	m	4,98	278,88
45	POS	02.01.03	xxx	66,000	m	8,71	574,86
46	TI	02.02	xxx
47	POS	02.02.01	xxx	23,000	m²	16,66	383,18
48	POS	02.02.02	xxx	5,000	Stk	74,37	371,85

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Die Anzahl der LOS und TI in Spalte 1 kann varieren, es kann auch sein das LOS nicht vorhanden ist:

	A	B	C	D	E	F	G
28	TI	01	xxx
29	POS	01.01	xxx	33,000	m²	186,46	6.153,18
30	EPOS	01.02	xxx	44,000	m²	5,81	255,64
31	HP	01.03	xxx	1,000	psch.	2.357,74	2.357,74
32	HPEPOS	01.04	xxx	1,000	psch.	1.546,71	1.546,71
33	POS	01.05	xxx	245,000	m²	48,93	11.987,85
34	POS	01.06	xxx	56,000	m²	31,30	1.752,80
35	POS	01.07	xxx	44,000	m²	39,02	1.716,88
36	TI	02	xxx
37	POS	02.01	xxx	233,000	m²	15,77	3.674,41
38	POS	02.02	xxx	34,000	m²	10,56	359,04
39	POS	02.03	xxx	5,000	Stk	8,71	43,55
40	TI	03	xxx
41	POS	03.01	xxx	44,000	m	41,93	1.844,92
42	POS	03.02	xxx	56,000	m	4,98	278,88
43	POS	03.03	xxx	66,000	m	8,71	574,86
44	TI	04	xxx
45	POS	04.01	xxx	23,000	m²	16,66	383,18
46	POS	04.02	xxx	5,000	Stk	74,37	371,85

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Als Ergebnis hätte ich gerne:

	A	B	C	D	E	F	G
28	LOS	01	xxx
29	TI	01.01	xxx
30	POS	01.01.01	xxx	33,000	m²	186,46	6.153,18
31	EPOS	01.01.02	xxx	44,000	m²	5,81	255,64
32	HP	01.01.03	xxx	1,000	psch.	2.357,74	2.357,74
33	HPEPOS	01.01.04	xxx	1,000	psch.	1.546,71	1.546,71
34	POS	01.01.05	xxx	245,000	m²	48,93	11.987,85
35	POS	01.01.06	xxx	56,000	m²	31,30	1.752,80
36	POS	01.01.07	xxx	44,000	m²	39,02	1.716,88
37			Summe Titel 01.01 xxx				25.770,80
38	TI	01.02	xxx
39	POS	01.02.01	xxx	233,000	m²	15,77	3.674,41
40	POS	01.02.02	xxx	34,000	m²	10,56	359,04
41	POS	01.02.03	xxx	5,000	Stk	8,71	43,55
42			Summe Titel 01.02 xxx				4.077,00
43			Summe Los 01 xxx				29.847,80
44	LOS	02	xxx
45	TI	02.01	xxx
46	POS	02.01.01	xxx	44,000	m	41,93	1.844,92
47	POS	02.01.02	xxx	56,000	m	4,98	278,88
48	POS	02.01.03	xxx	66,000	m	8,71	574,86
49			Summe Titel 02.01 xxx				2.698,66
50	TI	02.02	xxx
51	POS	02.02.01	xxx	23,000	m²	16,66	383,18
52	POS	02.02.02	xxx	5,000	Stk	74,37	371,85
53			Summe Titel 02.02 xxx				755,03
54			Summe Los 02 xxx				3.453,69
55			Gesamtsumme				33.301,49

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
bzw. wenn kein LOS vorhanden dann:

	A	B	C	D	E	F	G
28	TI	01	xxx
29	POS	01.01	xxx	33,000	m²	186,46	6.153,18
30	EPOS	01.02	xxx	44,000	m²	5,81	255,64
31	HP	01.03	xxx	1,000	psch.	2.357,74	2.357,74
32	HPEPOS	01.04	xxx	1,000	psch.	1.546,71	1.546,71
33	POS	01.05	xxx	245,000	m²	48,93	11.987,85
34	POS	01.06	xxx	56,000	m²	31,30	1.752,80
35	POS	01.07	xxx	44,000	m²	39,02	1.716,88
36			Summe Titel 01				25.770,80
37	TI	02	xxx
38	POS	02.01	xxx	233,000	m²	15,77	3.674,41
39	POS	02.02	xxx	34,000	m²	10,56	359,04
40	POS	02.03	xxx	5,000	Stk	8,71	43,55
41			Summe Titel 02				4.077,00
42	TI	03	xxx
43	POS	03.01	xxx	44,000	m	41,93	1.844,92
44	POS	03.02	xxx	56,000	m	4,98	278,88
45	POS	03.03	xxx	66,000	m	8,71	574,86
46			Summe Titel 03				2.698,66
47	TI	04	xxx
48	POS	04.01	xxx	23,000	m²	16,66	383,18
49	POS	04.02	xxx	5,000	Stk	74,37	371,85
50			Summe Titel 04				755,03
51			Gesamtsumme				33.301,49

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Wie muss der Code dazu lauten, um dass umzusetzen?
Noch zur Ergänzung: Bis jetzt ist dieses Array noch nicht unbedingt im Tabellenblatt, sondern nur in der Listbox, daher die Frage, ob man das erst in die Tabelle schreiben sollte und dann zurück in die LB, oder ob es möglich ist, das ganze nur in der LB zu realisieren.
Da dass ganze ja variabel ist, also die Anzahl der LOS und TI nie eindeutig vorgegeben sind, und auch die Anzahl der zugehörigen POS, EPOS, HP, HPEPOS varieren kann, beiss ich mir die Zähne daran aus, den Summenbereich automatisch flexibel zu bilden.
Für Anstupser in die richtige Richtung oder auch Fundstellen im Archiv(habe da leider noch nichts gefunden) bedanke ich mich im Voraus
MfG Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Forum,
ein klein bisschen bin ich schon weiter gekommen, nur die zuordnungen stimmen noch nicht ganz.
Sub ZwischensummeTI() Dim zeilesuchti As Long, zeileti As Long, zeilesuchlos As Long, zeilelos As Long, zeileanz As _ Long, suchende As Long suchende = Cells(Rows.Count, 1).End(xlUp).Row + 2 For zeileanz = 28 To suchende If Cells(zeileanz, 1).Value = "LOS" Then anzlos = anzlos + 1 End If If Cells(zeileanz, 1).Value = "TI" Then anzti = anzti + 1 End If Next zeileanz If anzti > 0 Then For zeilesuchti = suchende To 28 Step -1 If Cells(zeilesuchti, 1).Value = "TI" And WorksheetFunction.CountIf(Range(Cells( _ zeilesuchti, 1), Cells(suchende, 1)), "TI") 0 Then For zeilesuchlos = suchende To 28 Step -1 If Cells(zeilesuchlos, 1).Value = "LOS" And WorksheetFunction.CountIf(Range(Cells( _ zeilesuchlos, 1), Cells(suchende, 1)), "LOS") Ergebnis:

	A	B	C	D	E	F	G
28	LOS	01	xxx
29	TI	01.01	xxx
30	POS	01.01.01	xxx	33,000	m²	186,46	6.153,18
31	EPOS	01.01.02	xxx	44,000	m²	5,81	255,64
32	HP	01.01.03	xxx	1,000	psch.	2.357,74	2.357,74
33	HPEPOS	01.01.04	xxx	1,000	psch.	1.546,71	1.546,71
34	POS	01.01.05	xxx	245,000	m²	48,93	11.987,85
35	POS	01.01.06	xxx	56,000	m²	31,30	1.752,80
36	POS	01.01.07	xxx	44,000	m²	39,02	1.716,88
37			Summe Titel 01.01 xxx				25.770,80
38	TI	01.02	xxx
39	POS	01.02.01	xxx	233,000	m²	15,77	3.674,41
40	POS	01.02.02	xxx	34,000	m²	10,56	359,04
41	POS	01.02.03	xxx	5,000	Stk	8,71	43,55
42			Summe LOS 01 xxx				29.847,80
43	LOS	02	xxx
44			Summe Titel 01.02 xxx				4.077,00
45	TI	02.01	xxx
46	POS	02.01.01	xxx	44,000	m	41,93	1.844,92
47	POS	02.01.02	xxx	56,000	m	4,98	278,88
48	POS	02.01.03	xxx	66,000	m	8,71	574,86
49			Summe Titel 02.01 xxx				2.698,66
50	TI	02.02	xxx
51	POS	02.02.01	xxx	23,000	m²	16,66	383,18
52	POS	02.02.02	xxx	5,000	Stk	74,37	371,85
53
54

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Soll Ergebnis:

	A	B	C	D	E	F	G
28	LOS	01	xxx
29	TI	01.01	xxx
30	POS	01.01.01	xxx	33,000	m²	186,46	6.153,18
31	EPOS	01.01.02	xxx	44,000	m²	5,81	255,64
32	HP	01.01.03	xxx	1,000	psch.	2.357,74	2.357,74
33	HPEPOS	01.01.04	xxx	1,000	psch.	1.546,71	1.546,71
34	POS	01.01.05	xxx	245,000	m²	48,93	11.987,85
35	POS	01.01.06	xxx	56,000	m²	31,30	1.752,80
36	POS	01.01.07	xxx	44,000	m²	39,02	1.716,88
37			Summe Titel 01.01 xxx				25.770,80
38	TI	01.02	xxx
39	POS	01.02.01	xxx	233,000	m²	15,77	3.674,41
40	POS	01.02.02	xxx	34,000	m²	10,56	359,04
41	POS	01.02.03	xxx	5,000	Stk	8,71	43,55
42			Summe Titel 01.02 xxx				4.077,00
43			Summe LOS 01 xxx				29.847,80
44	LOS	02	xxx
45	TI	02.01	xxx
46	POS	02.01.01	xxx	44,000	m	41,93	1.844,92
47	POS	02.01.02	xxx	56,000	m	4,98	278,88
48	POS	02.01.03	xxx	66,000	m	8,71	574,86
49			Summe Titel 02.01 xxx				2.698,66
50	TI	02.02	xxx
51	POS	02.02.01	xxx	23,000	m²	16,66	383,18
52	POS	02.02.02	xxx	5,000	Stk	74,37	371,85
53			Summe Titel 02.02 xxx				755,03
54			Summe LOS 02 xxx				3.453,69

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8
Was muss man noch ändern, damit die Zuordnung stimmt, und die letzte Titel- bzw. Lossumme auch mit eingetragen wird?
MfG Christian

Sub ZwischensummeTILO() Dim zeilesuchti As Long, zeileti As Long, zeilesuchlos As Long, zeilelos As Long, zeileanz As _ Long, _ suchende As Long, suchendeti As Long, suchendelos As Long suchende = Cells(Rows.Count, 3).End(xlUp).Row + 1 For zeileanz = 28 To suchende If Cells(zeileanz, 1).Value = "LOS" Then anzlos = anzlos + 1 End If If Cells(zeileanz, 1).Value = "TI" Then anzti = anzti + 1 End If Next zeileanz suchendelos = suchende + anzti Application.ScreenUpdating = False If anzti > 0 And anzlos > 0 Then For zeilesuchti = suchende To 28 Step -1 If Cells(zeilesuchti, 1).Value = "TI" And Cells(zeilesuchti - 1, 1).Value "LOS" Or _ Cells(zeilesuchti, 1).Value = "" Or Cells(zeilesuchti, 1).Value = "LOS" And Cells( _ zeilesuchti - 1, 1).Value "" Then Rows(zeilesuchti).Insert zeileti = zeilesuchti - 1 Do Until Cells(zeileti, 1).Value = "TI" zeileti = zeileti - 1 If zeileti = 1 Then Exit Do Loop Cells(zeilesuchti, 7).Value = WorksheetFunction.sum(Range(Cells(zeileti, 7), Cells( _ zeilesuchti - 1, 7))) Cells(zeilesuchti, 3).Value = "Summe Titel " & Cells(zeileti, 2).Value & " " & Cells( _ zeileti, 3).Value End If Next zeilesuchti End If If anzti > 0 And anzlos = 0 Then For zeilesuchti = suchende To 28 Step -1 If Cells(zeilesuchti, 1).Value = "TI" And _ WorksheetFunction.CountIf(Range(Cells(zeilesuchti, 1), Cells(suchende, 1)), "TI") 0 Then For zeilesuchlos = suchendelos To 28 Step -1 If Cells(zeilesuchlos, 1).Value = "LOS" And _ WorksheetFunction.CountIf(Range(Cells(zeilesuchlos, 1), Cells(suchendelos, 1)), "LOS")

Option Explicit Sub TestIt() Dim i As Long, lngLR As Long Dim lngRwLos As Long, lngRwTi As Long Dim dblSumLos As Double, dblSumTi As Double With Sheets("Tabelle1") lngLR = .Cells(.Rows.Count, 1).End(xlUp).Row lngRwTi = lngLR + 1 lngRwLos = lngLR + 1 For i = lngLR To 1 Step -1 If .Cells(i, 1) = "LOS" Then .Rows(lngRwLos).Insert .Cells(lngRwLos, 3) = "Summe Los " & .Cells(i, 2) & " " & .Cells(i, 3) .Cells(lngRwLos, 7) = dblSumLos dblSumTi = 0 dblSumLos = 0 lngRwTi = i lngRwLos = i ElseIf .Cells(i, 1) = "TI" Then .Rows(lngRwTi).Insert .Cells(lngRwTi, 3) = "Summe Titel " & .Cells(i, 2) & " " & .Cells(i, 3) .Cells(lngRwTi, 7) = dblSumTi dblSumTi = 0 lngRwTi = i lngRwLos = lngRwLos + 1 Else dblSumLos = dblSumLos + .Cells(i, 7).Value dblSumTi = dblSumTi + .Cells(i, 7).Value End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zwischensummen einfügen per VBA

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread