Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1820to1824
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
Zeilen in Spalten
01.04.2021 19:34:59
Peter
Hallo Excelfreunde
Ich habe folgende Tabelle:
Artikel Bezeichnung
11111 Test1
11111 Test2
11111 Test3
11111 Test4
11111 Test5
11111 Test6
11111 Test7
22222 Test8
22222 Test9
22222 Test10
22222 Test11
22222 Test12
22222 Test13
22222 Test14
22222 Test15
22222 Test16
Es kann vorkommen, dass jeweils 200 verschiedene Bezeichnungen existieren, was dann zur Folge hat, dass sich die Artikelnummer bis zu 200 Mal wiederholen kann. Ich würde gerne über ein Makro das Ganze so umstellen, dass jeweils die Artikelnummer nur noch einmal vorkommt und die Bezeichnungen zusammengesetzt in einer Spalte neben der Artikelnummer stehen.
Das sollte dann so aussehen:
Artikel
11111 Test1, Test2, Test3 etc.
Für Eure Unterstützung bin ich Euch sehr dankbar.
Lieber Gruss
Peter

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen in Spalten
01.04.2021 21:02:31
Nepumuk
Hallo Peter,
teste mal:
Option Explicit
Public Sub Zusammenfassen()
Dim avntValues As Variant, avntKeys As Variant
Dim ialngIndex As Long, lngRow As Long
Dim objDictionary As Object
avntValues = Range(Cells(2, 1), Cells(Rows.Count, 2).End(xlUp)).Value
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
With objDictionary
For ialngIndex = LBound(avntValues) To UBound(avntValues)
If .Exists(Key:=avntValues(ialngIndex, 1)) Then
.Item(Key:=avntValues(ialngIndex, 1)) = _
.Item(Key:=avntValues(ialngIndex, 1)) & ", " & avntValues(ialngIndex, 2)
Else
.Item(Key:=avntValues(ialngIndex, 1)) = ", " & avntValues(ialngIndex, 2)
End If
Next
Call Range(Cells(2, 1), Cells(Rows.Count, 2)).ClearContents
avntKeys = .Keys
avntValues = .Items
lngRow = 2
For ialngIndex = LBound(avntKeys) To UBound(avntKeys)
Cells(lngRow, 1).Value = avntKeys(ialngIndex)
Cells(lngRow, 2).Value = Mid$(avntValues(ialngIndex), 3)
lngRow = lngRow + 1
Next
End With
Set objDictionary = Nothing
End Sub

Gruß
Nepumuk

Anzeige
AW: Zeilen in Spalten
01.04.2021 21:29:27
Peter
Hallo zusammen
Vielen Dank für Eure Hilfe.
Hat alles bestens funktioniert. Ihr seid die Besten :-)
Ich wünsche Euch schöne Ostern!
Lieber Gruss
Peter

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige