Excel 2007 Daten neu sortieren

Hallo,
habe eine Tabelle mit 2 Spalten, die ungefähr so aussieht:
Recordnumber 1
Systemnumber 14178994
Title Supermarine Spitfire Mk. 1-XV1 in RAF
Edition Stiffened ed.
Publisher/year Osprey Publishing Ltd., 1968 (1971)
Series ( Aircam aviation series ; No. 4)
Addedname Hooton, Ted compiler.
Addedname Ward, Richard
Holdinginfo X24/4064
Shelfmark X24/4064
Recordnumber : 1
Author Ward, Richard
Title Lockheed P-38 Lightning in USAAF.
Publisher/year Reading : Osprey, [1969]
Series ( Aircam aviation series ; no.10)
Subject Lightning (Fighter planes)
Subject Pictorial works
Addedname McDowell, Ernest R.
Holdinginfo YA.1999.b.3551
ISBN 0850450101
Shelfmark YA.1999.b.3551
Recordnumber : 4
Systemnumber 10960635
Author Shores, Christopher F.
Title 2nd TAF
Publisher/year Reading : Osprey, 1970.
Subject World War, 1939-1945 -- Aerial operations
Subject World War 2 Air campaigns Royal Air Force
Addedname Ward, Richard
ISBN 0850450306
Shelfmark 74/4334
(Leider wird es hier nicht richtig dargestellt. Also das jeweils erste Wort einer Zeile ist der Wert der ersten Spalte, dann folgt der Wert der zweiten Spalte.)
Daraus möchte ich nun eine Tabelle machen, deren Spaltenüberschrift aus den Daten der ersten Spalte besteht und die Daten der zweiten Spalte dann entsprechend darunter stehen. Das Problem dabei ist, dass außer der jeweils ersten Zeile (Recordnumber) immer unterschiedliche Angaben folgen, z.T. auch in unterschiedlicher Reihenfolge und dass nicht alle Angaben immer vorhanden sind und die entsprechenden Zellen dann leer bleiben sollen. Könnte das ganze natürlich per Hand zusammenstellen, aber meine Tabelle hat ca. 46.500 Zeilen, wäre also etwas aufwändig. Hat jemand eine Lösung für dieses Problem?
Für alle Antworten sag' ich jetzt schon mal vielen Dank!
Gruß
Phuong

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub umsetzen() Dim lZeile As Long Dim i As Long Dim z As Long Dim s As Long Dim total As Long Dim shQuelle As String Dim key0 As String 'Quelle definieren shQuelle = ActiveSheet.Name 'das aktiveSheet verwenden 'letzte Zeile der Spalte A ermitteln (1) lZeile = Sheets(shQuelle).Cells(65536, 1).End(xlUp).Row 'neues Sheet anhängen ThisWorkbook.Worksheets.Add 'Daten übernehmen z = 2 ' erstel zeile im neuem Sheet For i = 1 To lZeile 'key ermitteln: If Len(Sheets(shQuelle).Cells(i, 1)) > 0 Then key0 = Sheets(shQuelle).Cells(i, 1) ' Key aus 1. Spalte wert = Sheets(shQuelle).Cells(i, 2) ' Wert aus 2. Spalte 'spalte suchen For s = 1 To Cells(1, 256).End(xlToLeft).Column If Cells(1, s) = key0 Then n = s Exit For Else n = Cells(1, 256).End(xlToLeft).Column + 1 End If Next s Cells(1, n) = key0 'Eintragen Cells(z, n) = wert Else z = z + 1 End If Next i End Sub

Hallo Ede,
habe die Tabelle überprüft und bis auf einen Punkt hat es wirklich super funktioniert: Es gibt Datensätze, bei denen es mehrere Zeilen mit Werten für eine Spalte gibt. Beispiel:
Record number : 1
System number 5593126
Nat. bib. no. GB7115910 bnb
Author Ward, Richard, 1918-
Title Aerobatic teams, 1950-1970 / illustrated and compiled by Richard Ward. Vol.1.
Publisher/year Reading : Osprey Publishing, 1971.
Physica descr. [50]p(chiefly illus(some col)) ; 25cm.
Series ( Aircam aviation series ; no.S7)
Generalnote In 3 vols.
Subject Stunt flying.
Subject Aeroplanes, Military.
Subject Aerobatic display teams Military aircraft Illustrations
Holdinginfo v57 pt1 0777.650000
ISBN 0850450462 (pbk) : Â£1.05
Deweyno. 623.7/46 18
Shelfmark v57 pt1 0777.650000
Es gibt hier also 3 Werte, die unter der Spalte Subject erscheinen sollten, entweder alle zusammengefasst in einer Zelle, oder auch in mehrere Spalten mit gleichem Namen. Das Zusammenführen dieser Werte wäre dann kein Problem. Alle anderen Spaltenüberschriften (wie Author oder Generalnote) können auch mehrfach vorkommen.
Gibt es für dieses Problem eine Lösung?
Gruß
Phuong

Sub umsetzen() Dim lZeile As Long Dim i As Long Dim z As Long Dim s As Long Dim total As Long Dim shQuelle As String Dim key0 As String 'Quelle definieren shQuelle = ActiveSheet.Name 'das aktiveSheet verwenden 'letzte Zeile der Spalte A ermitteln (1) lZeile = Sheets(shQuelle).Cells(65536, 1).End(xlUp).Row 'neues Sheet anhängen ThisWorkbook.Worksheets.Add 'Daten übernehmen z = 2 ' erstel zeile im neuem Sheet For i = 1 To lZeile 'key ermitteln: If Len(Sheets(shQuelle).Cells(i, 1)) > 0 Then key0 = Sheets(shQuelle).Cells(i, 1) ' Key aus 1. Spalte wert = Sheets(shQuelle).Cells(i, 2) ' Wert aus 2. Spalte 'spalte suchen For s = 1 To Cells(1, 256).End(xlToLeft).Column If Cells(1, s) = key0 Then n = s Exit For Else n = Cells(1, 256).End(xlToLeft).Column + 1 End If Next s Cells(1, n) = key0 'Eintragen If Len(Cells(z, n)) > 0 Then Cells(z, n) = Cells(z, n) & " / " & wert Else Cells(z, n) = wert End If Else z = z + 1 End If Next i End Sub

Sub umsetzen2() Dim lZeile As Long Dim i As Long Dim z As Long Dim s As Long Dim total As Long Dim shQuelle As String Dim key0 As String Dim isda As Boolean 'Quelle definieren shQuelle = ActiveSheet.Name 'das aktiveSheet verwenden 'letzte Zeile der Spalte A ermitteln (1) lZeile = Sheets(shQuelle).Cells(65536, 1).End(xlUp).Row 'neues Sheet anhängen ThisWorkbook.Worksheets.Add 'Daten übernehmen z = 2 ' erstel zeile im neuem Sheet For i = 1 To lZeile 'key ermitteln: If Len(Sheets(shQuelle).Cells(i, 1)) > 0 Then key0 = Sheets(shQuelle).Cells(i, 1) ' Key aus 1. Spalte wert = Sheets(shQuelle).Cells(i, 2) ' Wert aus 2. Spalte 'spalte suchen isda = False n = 1 For s = 1 To Cells(1, 256).End(xlToLeft).Column If Cells(1, s) = key0 Then n = s isda = True Exit For Else n = Cells(1, 256).End(xlToLeft).Column + 1 End If Next s If Not isda Then Cells(1, n) = key0 ' neuen key eintragen End If 'Eintragen If Len(Cells(z, n)) > 0 Then 'doppelter Key, spalte erneut anhängen nn = Cells(1, 256).End(xlToLeft).Column + 1 Cells(1, nn) = key0 Cells(z, nn) = wert Else Cells(z, n) = wert End If Else z = z + 1 End If Next i End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread