PDA

Vollständige Version anzeigen : Mehrere Zellen kopieren


PeterPan89
16.07.2014, 11:39
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
.Cells(n,31 & 3 & 12 & 13)
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.

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

Mc Santa
16.07.2014, 13:01
Hallo,

mal genau auf die Frage bezogen:
.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)
wird zu
Union(.Cells(n, 31), .Cells(n, 3), .Cells(n, 12), .Cells(n, 13)).Copy wksActive.Cells(pos, 2)


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.07.2014, 16:24
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



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

PeterPan89
21.07.2014, 08:54
McSanta eine Idee?

Mc Santa
21.07.2014, 08:56
Hallo

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

VG

MWOnline
21.07.2014, 09:00
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 ;)

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 ;)

Beste Grüße
Marc

PeterPan89
21.07.2014, 09:49
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 ;)

Schon einmal vielen Dank für eure Hilfe.

VG PeterPan

Mc Santa
21.07.2014, 10:02
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