Zeilen in Spalten

Liebe Excelcracks
Ich habe folgendes Problem:
Ausgangslage
Ich habe eine Tabelle (Kunden mit mehreren Ansprechpersonen), die wie folg aufgebaut ist:
Kundennummer Ansprechpersonen
123 Hans Muster
123 Dieter Meier
123 Markus Müller
456 Thomas Meister
456 Inge Flück
456 Tamara Weisshaupt
Ich möchte nun, dass jeweils pro Kundennummer nur ein Datensatz in der Tabelle steht. Pro Ansprechperson soll jeweils autom. eine neue Spalte erstellt werden. Das würde dann so aussehen:
Kundennummer Ansprechperson_1 Ansprechperson_2 Ansprechperson_3
123 Hans Muster Dieter Meier Markus Müller
456 Thomas Meister Inge Flück Tamara Weisshaupt
Mit einer Kreuztabelle in Access habe ich es versucht. Jedoch bringt Access mir die Fehlermeldung, dass zu viele Kreuztabellenspaltenüberschriften vorhanden sind.
In Excel habe ich es mit Transponieren versucht. Da Excel 256 Spalten hat, bekomme ich auch hier eine ähnliche Fehlermeldung wie in Access. Auch mit der Funktion MTRANS habe ich es versucht. Leider ohne Erfolg.
Mit VBA kenne ich mich leider zuwenig aus. Oder gäbe es eine Lösung in VBA, welche sich auf meine Bedürfnisse leicht anpassen lässt?
Für Eure Hilfe bin ich Euch sehr dankbar.
Liebe Grüsse
Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ASP() Dim oDict As Object, arrDaten(), i As Long, rng As Range Set oDict = CreateObject("scripting.dictionary") For Each rng In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) If oDict.exists(rng.Value) Then oDict(rng.Value) = oDict(rng.Value) & vbTab & rng.Offset(, 1).Value Else oDict.Add rng.Value, rng.Value & vbTab & rng.Offset(, 1).Value End If Next arrDaten = oDict.items Cells(1, 4).Resize(oDict.Count) = WorksheetFunction.Transpose(arrDaten) Columns(4).TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _ TrailingMinusNumbers:=True For i = 1 To Cells(1, 4).CurrentRegion.Columns.Count - 1 Cells(1, i + 4) = "Ansprechpartner_" & i Next End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen in Spalten

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

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread