Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1388to1392
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Gleiche Werte zusammenfassen und Zellposition beib

Gleiche Werte zusammenfassen und Zellposition beib
27.10.2014 09:58:07
Bastian
Hallo liebe Excel Profis,
ich hänge gerade an einer "Baustelle" die ich nicht lösen kann und hoffe, dass ihr mir helfen könnt.
Ich verfüge über eine Liste wie z.B. diese:
------SpalteB---SpalteC---SpalteD---SpalteE
2-----Apfel-------Eins
3-----Apfel-------------------------------Zwei
4-----Birne-------Eins-------Zwei
5----Banane------------------------------Drei
und möchte das ganze dann so zusammenfassen, dass am Ende folgende Liste herauskommt
------SpalteB---SpalteC---SpalteD---SpalteE
2-----Apfel-------Eins-------Zwei
3-----Birne-------Eins-------Zwei
4----Banane------Drei
Im Prinzip (da ich nicht weiß ob die Aufteilung nachher nachvollziehbar dargestellt wird) die "Äpfel" Werte zusammenfassen und die Werte in der ersten Spalte beginnen lassen.
Bananenwert rückt aus E5 in C4, Apfel wird zusammengefasst und der Wert "Zwei" rückt aus E3 in D2. Die Spalten und Zeilenangabe ist willkürlich und nicht bindend.
Ich hoffe das ist ansatzweise verständlich, sonst sende ich auch gerne ein kurzes Bild dazu!
Besten Dank für eure Hilfe und auf bald,
Bastian

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Gleiche Werte zusammenfassen und Zellposition beib
27.10.2014 12:00:01
Rudi
Hallo,
als Ansatz:
Sub aaa()
Dim a, i As Long, j As Long, oo As Object, o
Set oo = CreateObject("scripting.dictionary")
a = Range(Cells(2, 2), Cells(2, 2).End(xlDown)).Resize(, 4)
For i = 1 To UBound(a)
For j = 2 To 4
If a(i, j)  "" Then
If oo.exists(a(i, 1)) Then
oo(a(i, 1)) = oo(a(i, 1)) & "|" & a(i, j)
Else
oo(a(i, 1)) = a(i, 1) & "|" & a(i, j)
End If
End If
Next j
Next i
For Each o In oo
a = Split(oo(o), "|")
Cells(Rows.Count, 10).End(xlUp).Offset(1).Resize(, UBound(a) + 1) = a
Next
End Sub

Gruß
Rudi
Anzeige

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige