Excel-Tabelle aus Liste erzeugen?

Hi,
ich habe ein (simples?) Problem, bei dem ich Unterstützung bräuchte.
Ich habe eine Tabelle, mit 2 Spalten (Name, Vorname) (über 1000 Datensätze)
In der Tabelle stehen Familien... in verschiedenen, wenn auch aufeinanderfolgenden Zeilen, aber leider getrennt.
Also z.B.
Zeile 1:
Spalte A:
Müller
Spalte B:
Peter
Zeile 2:
Spalte A:
Müller
Spalte B:
Elfriede
Zeile 3:
Müller
Sabrina
Zeile 4:
Schmitz
Klaus
Zeile 5:
Schmitz
Maria
usw.
Diese Tabelle würde ich gerne einlesen und in eine neuen Tabelle benutzerdefiniert ausgeben.
Dabei möchte ich gerne je Familie nur eine Zeile haben und die Vornamen in einer Spalte zusammenfügen:
Also z.B.
Zeile 1:
Spalte A: Müller
Spalte B: Peter / Elfriede / Sabrina
Zeile 2: hier möchte ich dann eine Zeile per Makro mit eigenen Werten zusammenbauen / einfügen.
Beispiel: Spalte A: "Adresse:" Spalte B: "Telefonnummer:" Spalte C: ...u.s.w.
ggf. folgen noch weitere Zeilen für diese eine Familie.
dann soll das Makro mit der nächsten Familie weitermachen:
Schmitz
Klaus / Maria
+ meine eigefügten Zeilen
Ich bin zwar eigentlich fit in Excel, habe aber schon lange nichts mehr gemacht...
Kann jemand einen Denkanstoß geben? Es muss wohl irgendwas mit einem Array und ein paar Schleifen sein...
habe aber wohl gerade eine Denkblockade...
Vielen Dank im Voraus an die Profis
Gruß
Jay

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Gruppieren() Range("C:Z").Clear z = 1 Cells(z, "C") = Cells(1, "A") Cells(z, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(1, "B") For i = 2 To Range("a1").End(xlDown).Row If Cells(i, "A") = Cells(i - 1, "A") Then Cells(z, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(i, "B") Else z = z + 2 Cells(z, "C") = Cells(i, "A") Cells(z, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(i, "B") End If Next i End Sub

@Marc
Danke für den Vorschlag. Leider macht es nicht das, was ich will.
Das Makro liest die Namen ein, und schreibt die Vornamen jeweils in Spalten rechts daneben.
Schau Dir mal meine Quell-Datei und mein erhofftes Ergebnis an (im ersten Thread).
Ich würde gerne eine Tabelle einlesen und die eingelesenen Daten angereichert mit eigenen Daten, die ich direkt im Quellcode angebe, in eine neue Tabelle schreiben.
Es muss hier nicht zwingend um Namen Vornamen und Adressen gehen.
Ich möchte generell die Funktionalität verstehen.
Es könnten auch ein Register / Aufzählung sein.
Das Quellformat ist immer
Spalte A: Index
Spalte B: Zum Index gehöriger Wert
In der nächsten Zeile kommt dann entweder ein neuer Index oder der gleiche Index mit einem neuen Wert in Spalte B.
Wenn gleicher Index, aber neuer Wert, dann lese Wert aus Spalte B und schreibe ihn in die gleiche Zeile neben den ersten Wert in der Zieltabelle.
Wenn neuer Index, dann füge Zeilen aus dem Code ein. (damit ist dann ein Datensatz komplett und es kann zum nächsten Index gehen)
Ich möchte also im Ziel:
Spalte A: Index
Spalte B Zeile 1 (bzw. in der gleichen Zeile der Fundstelle Index): Zum Index gehöriger Wert / Zum Index gehöriger 2. Wert / Zum Index gehöriger n-ter Wert
d.h. die Daten, die in Spalte B in Zeilen untereinander stehen sollen im Ziel in Spalte B nebeneinander mit "/" als Separator stehen.
Dann sollen einige Zeilen eigene Daten kommen, die ich direkt aus dem Quellcode in die Tabelle schreibe.
Und dann soll es mit dem nächsten Index weitergehen...
Viele Grüße
Jay

Sub Gruppieren() Range("C:Z").Clear fr_zei = Application.InputBox("wieviel freizeilen?") + 1 z = 1 Range(Cells(z, "C"), Cells(z + fr_zei, "C")) = Cells(1, "A") Cells(z, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(1, "B") Cells(z + 1, 4) = "Adresse" Cells(z + 1, 5) = "Telefonnummer" Cells(z + 1, 6) = "email" Cells(z + 1, 7) = "sonstiges" Cells(z + 1, 8) = "blabla" For i = 2 To Range("a1").End(xlDown).Row If Cells(i, "A") = Cells(i - 1, "A") Then Cells(z, "D") = Cells(z, "D") & " / " & Cells(i, "B") Else z = z + fr_zei Range(Cells(z, "C"), Cells(z + fr_zei, "C")) = Cells(i, "A") Cells(z, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(i, "B") Cells(z + 1, 4) = "Adresse" Cells(z + 1, 5) = "Telefonnummer" Cells(z + 1, 6) = "email" Cells(z + 1, 7) = "sonstiges" Cells(z + 1, 8) = "blabla" End If Next i End Sub

Sub Liste() Dim objData As Object, rngC As Range Const sDelim As String = "/ " Set objData = CreateObject("Scripting.Dictionary") 'Daten sammeln For Each rngC In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) If objData.exists(rngC.Value) Then objData(rngC.Value) = objData(rngC.Value) & sDelim & rngC.Offset(, 1).Value Else objData(rngC.Value) = rngC.Offset(, 1).Value End If Next 'Ausgabe With Sheets(2) .Cells(1, 1).Resize(objData.Count) = WorksheetFunction.Transpose(objData.keys) .Cells(1, 2).Resize(objData.Count) = WorksheetFunction.Transpose(objData.items) End With End Sub

Sub Liste() Dim objData As Object, rngC As Range, sKey As String Const sDelim As String = " / " Set objData = CreateObject("Scripting.Dictionary") 'Daten sammeln For Each rngC In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) sKey = Trim(rngC) If objData.exists(sKey) Then objData(sKey) = objData(sKey) & sDelim & rngC.Offset(, 1).Value Else objData(sKey) = rngC.Offset(, 1).Value End If Next 'Ausgabe With Sheets(2) .Cells(1, 1).Resize(objData.Count) = WorksheetFunction.Transpose(objData.keys) .Cells(1, 2).Resize(objData.Count) = WorksheetFunction.Transpose(objData.items) End With End Sub

Beliebteste Forumthreads (12 Monate)

Excel-Tabelle aus Liste erzeugen?

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel-Tabelle aus Liste erzeugen?

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread