Unterschiedlichen Spaltenköpfe sortie

Hallo
Seit längerem stellt sich wieder eine "unlösbare" Aufgabe für mich. Nachfolgend Beispieldaten zur Veranschaulichung:
Spalte A B C D
Jahr 2004 2005 2006 2007
Daten1 100 200 300 400
Daten2 20 15 7 5
Jahr 2005 2006 2007 2008
Daten3 140 250 350 450
Daten4 18 11 10 14
Daten5 52100 4200 9300 7400
Die Aufgabenstellung lautet nun, die Daten der jeweiligen Jahre in einer Spalte zu sammeln/sortieren, damit darauf aufgebaut werden kann. Eine manuelle Adaption ist auszuschließen, da es sich um Datenmengen zwischen 10.000 und 250.000 Zeilen handelt. Derzeit fehlt jeglicher Ansatz, dieses Problem zu lösen, da eine "fixe" Datenmanipulation über Bezüge nicht möglich ist, da sich die Größe der Datenblöcke ändert.
Für Ideen wäre ich äußerst dankbar. Betonen möchte ich, dass es keine fertige Lösung sein muss.Ein Musterfile ist angeschlossen unter https://www.herber.de/bbs/user/95359.xlsx
(ursprüngliche Quelle sind csv-Files).
Dankeschön
Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter,
in deiner 800-Zeilen Musterdatei dauert mein Makro knapp eine Minute, funktioniert aber. Bei 250000 Zeilen würde ich das ganze über Nacht laufen lassen, oder ein gutes Buch mitnehmen.
Ich bin mir sicher, es gibt noch Verbesserungspotential! Zum Beispiel könnte man die Zeilen in Gruppen verschieben statt jeder Zeile einzeln, das bringt bestimmt einiges. Auch könnte man bestimmt die Berechnungen welche ich über Hilfsspalten schiebe direkt im VBA vornehmen.
Aber:
Für Ideen wäre ich äußerst dankbar. Betonen möchte ich, dass es keine fertige Lösung sein muss.
Eine langsame fertige Lösung hast du jetzt, das werte ich mal als Idee. Eine schnell laufende Lösung kannst du ja selber entwickeln, das ist jetzt reine Fleißarbeit.

Sub ZeilenNachJahrSortieren()
Dim lRow As Long
Dim i As Long
Application.ScreenUpdating = False
With Sheets("500010 Key Ratios")
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:B1").EntireColumn.Insert
.Range("A3:A" & lRow).FormulaR1C1 = "=IF(OR(ISNUMBER(RC[3]),ISERROR(FIND(""-"",RC[3]))),R[- _
1]C,--LEFT(RC[3],4))"
.Range("B3:B" & lRow).FormulaR1C1 = "=RC[-1]-MIN(C[-1])"
For i = 3 To lRow
.Cells(i, 4).Resize(1, .Cells(i, 2).Value + 1).Insert shift:=xlToRight, CopyOrigin:= _
xlFormatFromLeftOrAbove
Application.StatusBar = "Zeile " & i & " von " & lRow & " in Bearbeitung"
Next i
.Range("D1").EntireColumn.Delete shift:=xlToLeft
.Range("A1:B1").EntireColumn.Delete shift:=xlToLeft
End With
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub

Grüße,
Klaus M.vdT.

Beliebteste Forumthreads (12 Monate)

Unterschiedlichen Spaltenköpfe sortie

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread