Liste automatisiert kürzen.

Hallo zusammen,
ich hatte vor einiger Zeit hier mal ein Makro freundlicherweise zur Verfügung gestellt bekommen, das ich hier auch beigefügt habe: https://www.herber.de/bbs/user/58852.txt
Dieses Makro kürzt eine Excel-Liste mit ca. 50000 Zeilen (!!!) auf wenige Dutzend Zeilen zusammen, so dass nur 1 Zeile pro Schlüssel übrigbleibt. Der Schlüssel ist/war dabei die Spalte A. Ich hoffe, dass ist soweit klar. Ich habe eine entsprechenden Auszug der Datei (nur wenige Zeilen) beigefügt:
https://www.herber.de/bbs/user/58853.xls
Jetzt zu meinen "Änderungswünschen":
1.) die Liste der ca. 50000 Datensätze sollte zunächst einmal um Datensätze bereinigt werden, die in Spalte B der Musterdatei eine "1" enthalten, d.h. diese Datensätze sollten komplett gelöscht werden.
2.) Anschließend sollte mit den Werte aus Spalte A und Spalte Spalte K pro Zeile eine Art "künstlicher neuer Schlüssel" generiert werden, also z. B. "73130" für Zeile 1 der Musterdatei und dieser Schlüssel sollte den bisherigen Schlüssel der Spalte A ersetzen, d.h. in Zelle A1 sollte statt "731" dann "73130" stehen usw.
3.) im dritten Schritt könnte man das bereits existierende Makro drüberlaufen lassen. Diese Makro würde dann die Liste um alle Zeilen bereinigen, für die bereits ein Schlüssel existiert. Immer die erste Zeile pro neuer Schlüssel sollte als Residuum übrigbleiben!
Wie lassen sich dieser 3 Schritte in einem Makro kombinieren! Die Performance (Ausgangsdatei mit mehr als 50000 Zeilen!) des Makros sollte eingermaßen gewährleistet sein und nicht den gesamten Rechner lahmlegen :-)
Im Voraus schon mal besten Dank für Vorschläge!!!
Viele Grüße
Bernd

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub lösch1() Application.ScreenUpdating = False Columns(2).Insert With Range("B:B") .FormulaR1C1 = "=IF(RC[1]=1,TRUE,ROW())" .Formula = .Value End With Cells.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal On Error Resume Next Range("B:B").Cells.SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete On Error GoTo 0 With Range("B:B") .FormulaR1C1 = "=RC[-1]&RC[10]" .Formula = .Value End With Range("B:B").Copy Range("A:A") Columns(2).Delete Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread