Doppelte einträge und listen

Hallo Excel Profis,
habe dieses mal ein ganz schweres Problem und hoffe das ihr mir helfen könntet.
Ich versuche es ganz genau zu erklären..
Habe zwei spalten A|B unter diesen Spalten stehen werte unter A stehen Zahlenwerte
4,444
4,442
2,434
23,555
usw..
und in Spalte B stehen Daneben P Nummern
p1234
p2345
p1122
p1255
p1234
p3233
p1234
p1255
usw...
Dabe stehen viele p Nummern Doppelt in dieser Spalte
A | B
4,3 p123
5,7 p345
1,3 p123
5,9 p123
usw.. usw...
Was ich jetzt möchte ist das es ab Spalte d neue Spalten überschriften gibt mit den einzelnen verschiedenen P-nummern
in dem obigen beispiel wären es dann
Spalte D |Spalte E |
1 | p123 | p345
2
3
4
5
usw..
in dem Beispiel wären es jetzt 2 neue Spalten weil in der Tabelle oben es nur zwei verschiedene Pnummern gibt die p123 und die p345.
Und dann soll noch unter den einzelen P-Nummern die summe summiert werden von den aus der obigen Tabelle in Spalte A und B die werte aufaddiert werden.
Also sollten unter p123 diese werte stehen 5,9 und 1,3 und 4,3 ....
und unter p345 dann die werte "5,7" .
Ich hoffe ich habe es einigermaßen verständlich erklärt , vielen Dank für eure Hilfe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Chris,
ne reine Array-Formellösung - wenn der Datenbereich nicht allzu groß ist (im Beispiel bis Zeile 100), dann dürfte das noch performant genug sein (andernfalls mit Hilfsspalten oder VBA arbeiten):
In D1:
{=WENN(SPALTE(A$1)&gtSUMME(WENN($B1:$B100&lt&gt"";1/ZÄHLENWENN($B1:$B100;$B1:$B100)));"";INDEX($B:$B;KKLEINSTE(WENN(ZÄHLENWENN(INDIREKT("B1:B"&ZEILE($1:$100));$B1:$B100)=1;ZEILE($1:$100));SPALTE(A$1))))}
und nach rechts kopieren.
In D2:
{=WENN(ZEILE($A1)&gtZÄHLENWENN($B:$B;D$1)*(D$1&lt&gt"");"";INDEX($A:$A;KKLEINSTE(WENN($B$1:$B$100=D$1;ZEILE($1:$100));ZEILE($A1))))}
und sowohl runter als auch nach rechts kopieren.
{geschweifte Klammern} nicht eingeben, sondern Formeleingabe mit Strg.Shift-Enter abschließen. Das erzeugt sie.
Grüße Boris

Sub chris_b() Dim l As Long, C As Range, fA As String, i As Long [d:iv].Clear [b:b].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[iv1], Unique:=True Range("IV1:IV" & [iv65536].End(xlUp).Row).Copy [d1].PasteSpecial Transpose:=True Columns(256).Delete For l = 1 To WorksheetFunction.CountA([d1:iv1]) i = 2 Set C = [b:b].Find(Cells(1, l + 3), lookat:=xlWhole) If Not C Is Nothing Then fA = C.Address Do Cells(i, l + 3) = C.Offset(0, -1) Set C = [b:b].FindNext(C) i = i + 1 Loop While Not C Is Nothing And C.Address <> fA Set C = Nothing i = 2 End If Next l End Sub

Sub Spalten() Dim i%, k%, vgl k = 2 With Sheets("Tabelle1") .Range(.Cells(1, 3), .Cells(2, 256)).ClearContents For i = 1 To .Cells(Rows.Count, 2).End(xlUp).Row vgl = Application.Match(.Cells(i, 2), .Range(.Cells(1, 3), .Cells(1, 256)), 0) If IsError(vgl) Then k = k + 1 .Cells(1, k) = .Cells(i, 2) .Cells(2, k) = .Cells(i, 1) Else: .Cells(2, vgl + 2) = .Cells(2, vgl + 2) + .Cells(i, 1) End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread