neue Datensätze aus bestehenden Datensätzen

23.01.2014 23:05:52

flo

Hallo zusammen,
ich stehe vor der Herausforderung:
Ein Kaufereignis besteht immer aus dem Kauf eines Apfels und einer Birne. Der Verkäufer von Apfel und Birne muss aber nicht der selbe sein. Eine Übersicht aller Kaufereignisse liegt mir vor, allerdings stehen die Verkäufer von Apfel und Birne in zwei unterschiedlichen Spalten. Ich möchte nun eine Übersicht erstellen, wo jedes Verkaufsereignis einzeln dargestellt wird, wenn der Verkäufer des Apfel ungleich des Verkäufers der Birne ist. Der Verkäufer des Apfels soll dann auch nur seinen Verkaufserlös sehen und der Verkäufer der Birne entsprechend nur seinen. Wenn der Verkäufer der selbe ist, muss der Datensatz nicht aufgeteilt werden. Ich habe dazu mal ein Beispiel angehängt. Mit Pivot-Tabellen komme ich hier nicht weiter und meine VBA-Kenntnisse reichen nicht aus, um das eigenständig abzubilden. Es wäre toll, wenn ich eine Hilfestellung bekommen könnte.
https://www.herber.de/bbs/user/88952.xlsx
Grüße,
Flo

AW: neue Datensätze aus bestehenden Datensätzen

24.01.2014 10:44:36

UweD

Hallo Flo
so?
Sub Äpfel() On Error GoTo Fehler Dim TB1, TB2, i&, j&, o% Dim SP%, ZE%, LR& Dim stCalc% With Application .ScreenUpdating = False stCalc = .Calculation .Calculation = xlCalculationManual End With Set TB1 = Sheets("Tabelle1") Set TB2 = Sheets("Tabelle2") SP = 6 'ab Spalte F ZE = 2 'ab Zeile 2 LR = TB1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte With TB2 .Cells.ClearContents .Cells(1, SP) = "Käufer" .Cells(1, SP + 1) = "Verkäufer" .Cells(1, SP + 2) = "Verkauf Apfel" .Cells(1, SP + 3) = "Verkauf Birne" .Cells(1, SP + 4) = "Apfelerlös" .Cells(1, SP + 5) = "Birnenerlös" .Cells(1, SP + 6) = "Verkaufserlös je Verkäufer und Käufer" j = 2 o = 0 'Offset für Doppeleintrag For i = ZE To LR .Cells(j, SP) = TB1.Cells(i, SP) 'Käufer .Cells(j, SP + 1) = TB1.Cells(i, SP + 1 + o) 'Verkäufer .Cells(j, SP + 2) = TB1.Cells(i, SP + 1) 'Verkäufer Apfel .Cells(j, SP + 3) = TB1.Cells(i, SP + 2) 'Verkäufer Birne .Cells(j, SP + 4) = TB1.Cells(i, SP + 3) 'Apfelerlös .Cells(j, SP + 5) = TB1.Cells(i, SP + 4) 'Birnenerlös .Cells(j, SP + 6) = IIf(.Cells(j, SP + 1) = .Cells(j, SP + 2), .Cells(i, SP + 4), 0) _ .Cells(j, SP + 6) = .Cells(j, SP + 6) + IIf(.Cells(j, SP + 1) = .Cells(j, SP + 3), . _ Cells(i, SP + 5), 0) j = j + 1 If TB1.Cells(i, SP + 1) TB1.Cells(i, SP + 2) And o = 0 Then ' Doppeleintrag i = i - 1 o = 1 Else o = 0 End If Next End With Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear With Application .ScreenUpdating = True If .Calculation stCalc Then .Calculation = stCalc End With End Sub Gruß UweD

AW: neue Datensätze aus bestehenden Datensätzen

24.01.2014 14:29:58

flo

Hallo UweD,
vielen Dank für Deine Hilfe. Ich bin zwischenzeitlich noch auf folgendes gestoßen:


Sub x()
Dim i As Long
For i = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To 1 Step -1
If Cells(i, 2).Value = Cells(i, 3).Value Then
Cells(i, 1).Value = Cells(i, 2).Value
Else
Rows(i + 1).Insert
Rows(i).Copy Rows(i + 1)
Cells(i + 1, 1).Value = Cells(i, 3).Value
Cells(i, 1).Value = Cells(i, 2).Value
End If
Next
End Sub

Bin gerade dabei das auf meine Anforderungen hin anzupassen. Deinen Code probiere ich gleich auch noch aus. Dann kann ich Dir mehr dazu sagen.
Gruß,
Flo

AW: neue Datensätze aus bestehenden Datensätzen

24.01.2014 11:12:30

fcs

Hallo Flo
stelle deine Ausgangsdaten

Nr.	Käufer	Verkäufer A	Verkäufer B	Erlös A	Erlös B
1	K 0001	V 0001		V 0005		1	10
2	K 0002	V 0002		V 0002		2	11
3	K 0003	V 0003		V 0001		3	12
4	K 0001	V 0004		V 0002		4	13
5	K 0002	V 0005		V 0003		5	14

in einer 2. Tabelle durch kopieren und Einfügen von Daten in folgende Form um.

Nr.	Käufer	Verkäufer	Produkt	Erlös
1	K 0001	V 0001		A	1
2	K 0002	V 0002		A	2
3	K 0003	V 0003		A	3
4	K 0001	V 0004		A	4
5	K 0002	V 0005		A	5
1	K 0001	V 0005		B	10
2	K 0002	V 0002		B	11
3	K 0003	V 0001		B	12
4	K 0001	V 0002		B	13
5	K 0002	V 0003		B	14

Danach kannst du die umgestellten Daten dann per Pivottabellenberichte auswerten oder auch neu sortieren und per Autofilter die jeweils nicht anzuzeigenden Datenzeilen ausblenden.
Gruß
Franz

Daten umgruppieren

24.01.2014 20:48:28

Erich

Hi Flo,
hier noch eine Alternative zum Ausprobieren:


Option Explicit
Sub Birnen()
Dim lngS As Long, lngZ As Long, arQ, arZ(), qq As Long, zz As Long
lngZ = 1  ' ab Zeile 1  (Überschriften)
lngS = 6  ' ab Spalte F (Käufer)
arQ = Sheets("Tabelle3").Cells(lngZ, lngS).CurrentRegion  ' Quelldaten
ReDim arZ(1 To 2 * UBound(arQ), 1 To 7)
' Spaltenüberschriften
arZ(1, 1) = arQ(1, 1)
arZ(1, 2) = "Verkäufer"
For qq = 2 To 5
arZ(1, qq + 1) = arQ(1, qq)
Next qq
arZ(1, 7) = "je Verk. und Käufer"
' Berechnung
zz = 1
For qq = lngZ + 1 To UBound(arQ)
zz = zz + 1
arZ(zz, 1) = arQ(qq, 1)
arZ(zz, 2) = arQ(qq, 2)
arZ(zz, 3) = arQ(qq, 2)
arZ(zz, 5) = arQ(qq, 4)
If arQ(qq, 2) = arQ(qq, 3) Then
arZ(zz, 4) = arQ(qq, 3)
arZ(zz, 6) = arQ(qq, 5)
arZ(zz, 7) = arZ(zz, 5) + arZ(zz, 6)
Else
arZ(zz, 7) = arZ(zz, 5) + arZ(zz, 6)
zz = zz + 1
arZ(zz, 1) = arQ(qq, 1)
arZ(zz, 2) = arQ(qq, 3)
arZ(zz, 4) = arQ(qq, 3)
arZ(zz, 6) = arQ(qq, 5)
arZ(zz, 7) = arZ(zz, 5) + arZ(zz, 6)
End If
Next qq
' Ausgabe in Zieltabelle
With Sheets("Tabelle5")
.Cells.ClearContents
.Cells(lngZ, lngS).Resize(UBound(arZ), 7) = arZ
End With
End Sub

Mit Formeln lässt sich das aber auch ganz gut erledigen. Hier mit einer Hilfsspalte M:

	F	G	H	I	J	K	L	M
6	Ist-Stand
7	Käufer	Verkauf Apfel	Verkauf Birne	Apfelerlös	Birnenerlös
8	willi	hans	wurst	1	2
9	tobi	hans	hans	1	2
10	AAAAAAA	Q	RRRRRRRRR	55	4444
11	tobi	hans	hans	1	2
12	C	DDDDDDD	F	1	2
13	lisa	wurst	wurst	1	2
14				60	4454	4514
15
16
17	Soll-Stand							Hilf
18	Käufer	Verkäufer	Verkauf Apfel	Verkauf Birne	Apfelerlös	Birnenerlös	Erlös je Verk. und Käufer	Qu-Satz
19	willi	hans	hans		1		1	1
20	willi	wurst		wurst		2	2	1
21	tobi	hans	hans	hans	1	2	3	2
22	AAAAAAA	Q	Q		55		55	3
23	AAAAAAA	RRRRRRRRR		RRRRRRRRR		4444	4444	3
24	tobi	hans	hans	hans	1	2	3	4
25	C	DDDDDDD	DDDDDDD		1		1	5
26	C	F		F		2	2	5
27	lisa	wurst	wurst	wurst	1	2	3	6
28							4514

Formeln der Tabelle

Zelle	Formel
I14	=SUMME(I8:I13)
J14	=SUMME(J8:J13)
K14	=SUMME(I14:J14)
F19	=INDEX($F$8:$F$13;M19)
G19	=INDEX($G$8:$H$13;M19;1+(M18=M19))
H19	=WENN(M18=M19;"";INDEX($G$8:$G$13;M19))
I19	=WENN((M18=M19)+(H19=INDEX($H$8:$H$13;M19)); INDEX($H$8:$H$13;M19); "")
J19	=WENN(H19="";"";INDEX(I$8:I$13;$M19))
K19	=WENN(I19="";"";INDEX(J$8:J$13;$M19))
L19	=SUMME(J19:K19)
M19	=KÜRZEN(1+ANZAHL($J$18:$K18)/2)

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

neue Datensätze aus bestehenden Datensätzen

Forumthread: neue Datensätze aus bestehenden Datensätzen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

neue Datensätze aus bestehenden Datensätzen

Forumthread: neue Datensätze aus bestehenden Datensätzen

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

VBA Beispiele zu diesem und ähnlichen Themen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread