Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1444to1448
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ausfuehrung Code dauert sehr lange

Ausfuehrung Code dauert sehr lange
14.09.2015 18:20:39
Juergen
Hallo,
ich habe eine lange Liste (800.000 Zeilen), deren Inhalt ich je nach dem was in Spalte A fuer ein Zahlencode steht, in eine andere Tabelle ueberfuehre. Herausforderung ist lediglich an die richtige Stelle zu kommen, deshalb viele Spruenge mit xltoright, xlup, ...
Es funktioniert ansich ganz gut. ABER, ich benoetige fuer 1000 Zeilen bereits 5 Minuten. Wenn ich das hochrechne, dauern die 800.000 Zeilen 67 Stunden.
Ich bin mir sicher, man kann den Code verschlanken, leider reicht mein Anfaenger-VBA-Koennen nicht um beurteilen zu koennen wo man ansetzt.
Sieht jemand Potenzial, damit das schneller laeuft? Oder muss ich mich mit den 60 Stunden anfreunden?
Sub Copy()
Sheets("2-cut").Select
Application.ScreenUpdating = False
For t = 1 To 1000 'aktuell 1000 Zeilen, eigentlich aber 800.000
If Cells(t, 1).Value = "1" Then
Cells(t, 3).Select
Range(Selection, Selection.End(xlToRight)).Cut
Sheets("Final").Select
Range("A1048576").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("2-cut").Select
ElseIf Cells(t, 1).Value = "4" Then
Cells(t, 3).Select
Range(Selection, Selection.End(xlToRight)).Cut
Sheets("Final").Select
Range("A1048576").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("2-cut").Select
ElseIf Cells(t, 1).Value = "2" Then
Cells(t, 3).Select
Selection.Clear
Cells(t, 4).Select
Selection.Cut
Sheets("Final").Select
Range("A1048576").Select
Selection.End(xlUp).Select
Cells(ActiveCell.row, 15).Activate
ActiveSheet.Paste
Sheets("2-cut").Select
ElseIf Cells(t, 1).Value = "3" Then
Cells(t, 3).Select
Selection.Clear
Cells(t, 4).Select
Selection.Cut
Sheets("Final").Select
Range("A1048576").Select
Selection.End(xlUp).Select
Cells(ActiveCell.row, 15).Activate
Selection.End(xlToRight).Select
Selection.Offset(0, 1).Select
ActiveSheet.Paste
Sheets("2-cut").Select
ElseIf Cells(t, 1).Value = "5" Then
Cells(t, 3).Select
Selection.Clear
Cells(t, 4).Select
Selection.Cut
Sheets("Final").Select
Range("A1048576").Select
Selection.End(xlUp).Select
Cells(ActiveCell.row, 16).Activate
ActiveSheet.Paste
Sheets("2-cut").Select
End If
Next t
Application.ScreenUpdating = True
End Sub

Vielen Dank

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

Betreff
Datum
Anwender
Anzeige
Kein Wunder!
14.09.2015 18:53:42
RPP63
Hallo!
Die ganze Selektiererei ist völlig überflüssig.
1. Sortiere Spalte A in 2-cut
2. Wende den Autofilter auf Spalte A an und wähle 1, 2, 3, 4, 5
3. Schneide den sichtbaren Bereich unter der Überschrift ab Spalte C aus und füge ihn in die erste freie Zelle in Spalte B ein.
Zeitdauer für 800.000 Zeilen: höchstens fünf Sekunden.
Zeichne dies mal mit dem Rekorder auf.
Gruß Ralf

AW: Kein Wunder!
14.09.2015 19:12:46
Juergen
Sorry, da war ich wohl nicht praezise genug. Das Problem ist, dass die Anordung wie sie aktuell in der langen Liste ist, so in die neue Tabelle uebernommen werden muss. Ungefaehres Beispiel:
"Lange Liste":
A---B---C
1---x---d
2---k---l
3---p---o
1---f---g
3---y---h
Ueberfuehrt in "neue Tabelle":
A---B---C---D---E---F
x---d---k---l---p---o
f---g---_---_---y---h
Deswegen muss ich in der langen Liste von oben nach unten jede Zeile pruefen und dann nach und nach in die neue Tabelle uebertragen.
Verstaendlicher?

Anzeige
Beispieldatei
14.09.2015 19:19:59
RPP63
Hi!
Natürlich hilft Dir der Rekorder hierbei nicht weiter.
Erstelle bitte mal eine Beispieltabelle mit ca. 100 Zeilen und dem Ist- und Sollzustand.
Parallel zum Erstellen der Datei schreibe ich schon mal einen Code, den ich aber, bevor ich ihn hier hereinstelle, erst am lebenden Objekt testen will.
Gruß Ralf

53 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige