Excel - Zeilen kopieren und in neues Tabellenblatt einfügen dauert sehr lange

Question

Hallo zusammen,

ich habe einen gut funktionieren Code, der mir Zeilen, die in Spalte M mit einem Datum versehen sind, in ein anderes Tabellenblatt verschiebt. Dort wird es in der ersten freien Zeile wieder eingefügt.

Nun ist es aber so, dass in meiner Zieltabelle bereits über 2000 Zeilen drin sind und ich meine, dass das Makro immer länger braucht, um die Zeilen zu verschieben.

Jetzt meine Frage, gibt es eine Möglichkeit, mein Makro etwas zu tunen um es schneller zu machen (bringt es z.B. was, wenn man in der Zieltabelle erst ab der Zeile 2000 eine leere Zeile suchen lässt?) und mir gleichzeitig erklären, was und wie es funktioniert? Wäre absolut klasse.


Private Sub Workbook_Open()
Dim lngLetzte As Long
Dim lngZeile As Long
With Worksheets("Erledigt")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Start")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 13) >= 1 Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 21)).Cut Worksheets("Ziel").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With
End Sub


Vielen Dank schon mal im Voraus.

VG
Florian

Answer 1

Hier nochmal der Code in besserer Sichtweise. - Sorry

Private Sub Workbook_Open()
Dim lngLetzte As Long
Dim lngZeile As Long
With Worksheets("Erledigt")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Übersicht")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 13) >= 1 Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 21)).Cut Worksheets("Erledigt").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With
End Sub

Answer 2

Hallo Florian,

Ob es nicht bei zunehmenden Datenvolumen irgendwann sinnvoll wäre auf ein Datenbankmodell umzusteigen. oder zumindest in Zusammenarbeit mi Excel solche Jobs in einer Datenbank (Filterung über Abfragen) durchführen zu lassen.

Natürlich nur dann, wenn es in das Konzept und in den Arbeitsablauf passt.

Das nur so nebenbei als Anregung.

Gruß

Paul1

[sub]Excel > Access > MS-Office 2003
MS Windows XP Professional SP3
MS Windows 7 Professional SP1
ECDL-Syllabus Version 4.0[/sub]

Answer 3

Hallo Paul1,

grundsätzlich hast du auf jeden Fall Recht. Nur ist es mir momentan noch nicht möglich, auf Datenbanken umzusteigen.

Aber würde es überhaupt Sinn machen, Excel in der Zieltabelle erst ab Zeile 2000 nach einer freien Zeile suchen zu lassen, oder würde man eine solche Änderung gar nicht wirklich spüren?

VG
Florian

Answer 4

Hallo Florian,

durch die Filterung und Sortierung in den erforderlichen Abfragen geht es auf jeden Fall schneller, aber unterhalten wir uns dann, wenn es soweit kommen sollte.

In diesem Fall wäre ein gut vorbereitetes Datenbankkonzept erforderlich, um alle Erfordernisse abzudecken.

Gruß

Paul1

Answer 5

Hallo Florian,

füge mal an Anfang (vor der With-Anweisung) die beiden folgenden Zeilen ein:

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'automatische Berechnung ausschalten
Application.Calculation = xlManual

Und am Ende (nach End With):

'automatische Berechnung einschalten
Application.Calculation = xlAutomatic

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

Gruß

M.O.

Answer 6

hi :-)

das sind fuer excek keine datemengen *g*

lege die Daten in ein Array
sortiere diese im Array und schreib es dann zurueck

gruss nighty

Answer 7

Hallo,

sorry, dass ich mich jetzt erst wieder melde, bin nur leider nicht früher dazu gekommen.

@ Paul1: Mit der Datenbank wird es sich leider noch einige Zeit hinziehen.

@ M.O.. Ebenfalls vielen Dank für den Vorschlag. Nur geht es damit gefühlt eher langsamer als schneller. Hab es wieder auf "ohne" eingestellt.

@ nighty: Wie soll das aussehen? Kenn mich mit Arrays noch nicht so wirklich aus.

VG
Florian

Answer 8

hi :-)

schick mir eine dummy Datei mit den Erfordernissen
das eventuelle spätere erstellte makro poste ich natuerlich fuer die Datenbank ^^

gruss nighty

meine email
oberley@t-online.de

Answer 9

Hallo Zusammen,

leider bin ich noch nicht wirklich weiter gekommen.

Es wäre super, wenn ihr über den Code drüber schaut. Was könnte ich noch tun, damit dies nicht ganz so lange dauert. In der Zieltabelle bin ich bereits bei Zeile 2.200

Sub Start()

Dim lngLetzte As Long
Dim lngZeile As Long
Dim azeile, zeile, lnummer As Long
Dim myRange As Range

On Error Resume Next
ThisWorkbook.Sheets("Erledigt").ShowAllData
ThisWorkbook.Sheets("Übersicht").ShowAllData


'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False


With Worksheets("Erledigt")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Übersicht")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 13) >= 1 Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 22)).Cut Worksheets("Erledigt").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With

'ab hier werden in der Tabelle Übersicht die Zeilen ergänzt
'höchste Zahl im Bereich zwischen A500 und A798 ermitteln
Set myRange = Worksheets("Übersicht").Range("A500:A798")
lnummer = Application.WorksheetFunction.Max(myRange)

'letzte Zeile mit einem Zahleneintrag in Spalte A ermitteln bzw. erste Zelle in der keine Zahl steht
For azeile = 2 To 798
If Worksheets("Übersicht").Cells(azeile, 1) = 0 Then Exit For
Next azeile

'Falls alle Zellen bis 798 eine Zahl beinhalten wird hier das Makro verlassen
If azeile = 798 Then Exit Sub

'Die Zellen mit den Formeln, Spalten B bis U werden bis Zeile 798 kopiert
For zeile = azeile To 798
'Zeile Einfügen
Worksheets("Übersicht").Rows(zeile).Insert Shift:=xlDown

'neue Nummer einfügen: höchste Nummer plus 1
lnummer = lnummer + 1
Worksheets("Übersicht").Cells(zeile, 1) = lnummer

'Spalten B bis V kopieren
Worksheets("Übersicht").Range(Cells(azeile - 1, 2), Cells(azeile - 1, 22)).Copy Worksheets("Übersicht").Range("B" & zeile)
Next zeile

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True


End Sub

Danke.

VG
Florian

Answer 10

hi :-)

keine email erhalten,ich bin dann raus,geh erst mal in Urlaub ^^

gruss nighty