Office: Mehrere Zellen kopieren

PeterPan89 · 14. Juli 2014

Hallo zusammen,

ich habe eine Frage bezüglich folgenden Codeausschnitt. Ich habe das gefühl, dass dieser Code meine Makro verlangsamt (ich muss zugeben dass ich von 1 to lngletzteZeile von circa 4000-5000 Einträgen spreche).

Ich denke der Code würde schneller werden wenn er nicht jede Zelle durch alle Schleifen laufen lassen müsste, sondern ich direkt alle zellen anspreche.

Also so in der Art
Code:

.Cells(n,31 & 3 & 12 & 13)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wobei dieser Code natürlich nicht funktioniert.

Wäre supper wenn mir jemand helfen könnte, denn zur Zeit dauert er 10-15min was ich möglichst schneller machen würde.

Code:

For n = 1 To lngLetzteZeile
If .Cells(n, 11) = wksActive.Cells(2, 1) Then
.Cells(n, 31).Copy wksActive.Cells(pos, 2)
.Cells(n, 3).Copy wksActive.Cells(pos, 3)
.Cells(n, 12).Copy wksActive.Cells(pos, 4)
.Cells(n, 13).Copy wksActive.Cells(pos, 5)
pos = pos + 1
End If
If wksAufruf.Cells(n, 79) = "XX" And wksAufruf.Cells(n, 11) = wksActive.Cells(2, 1) Then
.Cells(n, 20).Copy wksActive.Cells(pos - 1, 11)
End If
If .Cells(n, 145) = "YY" And wksAufruf.Cells(n, 11) = wksActive.Cells(2, 1) Then
.Cells(n, 20).Copy wksActive.Cells(pos - 1, 9)
End If
If .Cells(n, 11) = wksActive.Cells(2, 1) Then
.Cells(n, 116).Copy wksActive.Cells(pos - 1, 12)
End If

Next n
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

Mc Santa · 16. Juli 2014

Hallo,

mal genau auf die Frage bezogen:
Code:

.Cells(n, 31).Copy wksActive.Cells(pos, 2)
.Cells(n, 3).Copy wksActive.Cells(pos, 3)
.Cells(n, 12).Copy wksActive.Cells(pos, 4)
.Cells(n, 13).Copy wksActive.Cells(pos, 5)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

wird zu
Code:

Union(.Cells(n, 31), .Cells(n, 3), .Cells(n, 12), .Cells(n, 13)).Copy wksActive.Cells(pos, 2)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vermutlich wird der Code noch schneller, wenn du auch die Schleife selbst entfernst und alle zu kopierenden Zellen auf einmal nimmst. Dazu müsste man aber mehr vom Code sehen und die Datei dazu.

VG

PeterPan89 · 18. Juli 2014

Hi,

Das wäre mal so der Codeausschnitt.
Wkbaufruf ist eine ausgewählte Datei über ein Formular.

Autofilter ist schwierig weil die aufgerufene Datei sehr groß ist und dort FIltern dauert ewig.

Vielleicht hast du eine Idee

Gruß
PeterPan

Code:

Private Sub cmdOK_Click()
Dim wkbActive As Workbook
Dim wksAufruf As Worksheet
Dim wkbAufruf As Workbook
Dim wksActive As Worksheet
Dim n As Long
Dim pos As Long
Dim lngLetzteZeile As Long
Dim ptCache As PivotCache
Dim ptTable As PivotTable
Dim k As Integer

Application.StatusBar = "Makro"
Application.ScreenUpdating = False
Set wksActive = ThisWorkbook.Worksheets("XX")
Set wksData = ThisWorkbook.Worksheets("YY")
Set wkbActive = ThisWorkbook
'On Error GoTo ErrorHandler
Set wkbAufruf = Workbooks(FileName.Value)
Set wksAufruf = wkbAufruf.Worksheets("Hans")
pos = 7

Range("A7:AH2000").Clear

lngLetzteZeile = wksAufruf.Cells(Rows.Count, 11).End(xlUp).Row

With wksAufruf
For n = 1 To lngLetzteZeile
If .Cells(n, 11) = wksActive.Cells(2, 1) Then
Union(.Cells(n, 31), .Cells(n, 3), .Cells(n, 12), .Cells(n, 13)).Copy wksActive.Cells(pos, 2)
pos = pos + 1
End If
If wksAufruf.Cells(n, 79) = "cancel" And wksAufruf.Cells(n, 11) = wksActive.Cells(2, 1) Then
.Cells(n, 20).Copy wksActive.Cells(pos - 1, 11)
End If
If .Cells(n, 145) = "BL" And wksAufruf.Cells(n, 11) = wksActive.Cells(2, 1) Then
.Cells(n, 20).Copy wksActive.Cells(pos - 1, 9)
End If
If .Cells(n, 11) = wksActive.Cells(2, 1) Then
.Cells(n, 116).Copy wksActive.Cells(pos - 1, 12)
End If

Next n
End With

lngletzteZeile1 = wksActive.Cells(Rows.Count, 3).End(xlUp).Row

With wksActive
For m = 7 To lngletzteZeile1
.Cells(m, 10) = .Cells(m, 9) - .Cells(m, 11)
Next m
End With

lngletzteZeile1 = wksActive.Cells(Rows.Count, 3).End(xlUp).Row
With wksActive
For i = 7 To lngletzteZeile1
Cells(i, "H") = Application.VLookup(Cells(i, 3), wksData.Range("F10:CZ1000"), 37, False)
If IsError(Cells(i, "H")) = True Then Cells(i, "H") = ""
Cells(i, "N") = Application.VLookup(Cells(i, 3), wksData.Range("F10:CZ1000"), 28, False)
If IsError(Cells(i, "N")) = True Then Cells(i, "N") = ""
If Cells(i, "N") = "No" Then
Cells(i, "N") = "internal"
Else Cells(i, "N") = "no"

Cells(i, "O") = Application.VLookup(Cells(i, 3), wksData.Range("F10:CZ1000"), 13, False)
If IsError(Cells(i, "O")) = True Then Cells(i, "O") = ""
Cells(i, "P") = Application.VLookup(Cells(i, 3), wksData.Range("F10:CZ1000"), 14, False)
If IsError(Cells(i, "P")) = True Then Cells(i, "P") = ""
Cells(i, "S") = Application.VLookup(Cells(i, 3), wksData.Range("F10:CZ1000"), 39, False)
If IsError(Cells(i, "S")) = True Then Cells(i, "S") = ""
Cells(i, "AA") = Application.VLookup(Cells(i, 3), wksData.Range("F10:CZ1000"), 11, False)
If IsError(Cells(i, "AA")) = True Then Cells(i, "AA") = ""
Cells(i, "AC") = Application.VLookup(Cells(i, 3), wksData.Range("F10:CZ1000"), 41, False)
If IsError(Cells(i, "AC")) = True Then Cells(i, "AC") = ""
Next i
End With

Application.StatusBar = False
Application.ScreenUpdating = True

Set wksActive = Nothing
Set wksAufruf = Nothing
Set wkbActive = Nothing
Set wkbAufruf = Nothing

Exit Sub

ErrorHandler:
MsgBox "Keine Datei ausgewählt.", vbInformation, "Datei wählen"
Exit Sub

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

PeterPan89 · 20. Juli 2014

McSanta eine Idee?

Mc Santa · 20. Juli 2014

Hallo

Dauert der Autofilter wirklich länger als das Makro selbst?

VG

MWOnline · 20. Juli 2014

Hallöchen!

wie Mc Santa schon schrieb, am besten eine Beispieldatei hochladen.

Ich kann es ja leider nicht testen, aber wenn Du die .Copy Methoden durch direkt Value-Zuweisung ersetzt, könnte es theoretisch auch schneller laufen.

Die VLookUps in der Schleife brauchen auch einige Zeit. Hast Du mal analysiert ob das Kopieren oder das Wertesuchen soviel Zeit benötigt? Einfach ausklammern den Code und mal testen *wink.gif*

Beim Kopiervorgang könntest Du zusätzlich noch die Berechnung ausschalten und vor den LookUps wieder einschalten.

Wie gesagt am besten ist eine Beispieldatei, dort können wir perfekt ausprobieren und sehen warum es so langsam läuft *wink.gif*

Beste Grüße
Marc

PeterPan89 · 20. Juli 2014

Hallo,

also das Filtern habe ich im Makro nicht ausprobiert, nur ist es so, dass die Datei aus der die Daten kommen viele Matrixformeln und Summenproduktformeln enthält und auch weiter wächst. Möchte mich nicht darauf verlassen wie sich diese Datei verhält, denn schon alleine Filtern in der Datei selbst dauert echt einige Zeit und kann in Kürze noch länger dauern.

Also ich habe mal den Code laufen lassen und denke, dass kopieren und die Vlookup Prozedur ungefähr die gleiche Zeit benötigen. (ingesamt mit einer Erstellung einer pivot so 6-8min für alles/3min nur kopieren).

Beispieldatei kann ich demnächst ansonsten mal erstellen (muss einige Sachen ändern/anonymisieren).

Kommt dann die Tage und ansonsten muss ich eben mit der Dauer der Makro leben *wink.gif*

Schon einmal vielen Dank für eure Hilfe.

VG PeterPan

Mc Santa · 20. Juli 2014

Hallo,

eine Zeit von 5min finde ich deutlich zu lange, für 2000 Zeilen.
Ich glaube da kann man einiges verschnellern.

Bitte erstelle die Datei so originalgetreu wie möglich. Behalte die Struktur bei und ändere nur die Einträge selbst (Text bleibt dabei Text, und Zahlen bleiben dabei Zahlen!)
So sind die gemachten Vorschläge auch am besten anzuwenden.

VG

Office: Mehrere Zellen kopieren

Mehrere Zellen kopieren

Mehrere Zellen kopieren

Mehrere Zellen kopieren

Mehrere Zellen kopieren

Mehrere Zellen kopieren - Similar Threads - Zellen kopieren

Nur markierte Zellen kopieren und wieder einfügen

Zellen aus Aktiver Zeile kopieren

Excel VBA - Code Hilfe (Spalten, Werte kopieren etc.)

Wert einer Zelle kopieren wenn..

Wenn in Zelle bestimmter Wert dann kopieren

Textausgabe eines Formelergebnisses in anderer Zelle

Zellen automatisch in ein neues Blatt kopieren wenn