Können Sie herausfinden, was mein Excel-VB-Skript verlangsamt?

Question

Zuerst ein wenig Hintergrund: Ich hatte eine Notwendigkeit für ein Skript n CSV-Dateien in einem Verzeichnis, das ich ausgewählt und kopieren und Einfügen ihrer individuellen Daten in eine "Master" Excel-Arbeitsmappe Datei mit n Tabs. Ich brauche auch das Skript, um den Tabs automatisch etwas Nützliches zu geben.

Ich Frankenstein'd ein Skript zusammen mit einer Kombination aus Makroaufnahmen, Stücke, die ich hier gefunden habe, und gut altmodisch Googeln. Es läuft ohne zu viele Fehler; Gegen Ende des Prozesses (wenn mehr als 10 CSV-Dateien vorhanden sind) wird die Geschwindigkeit jedoch etwas verlangsamt.

Ich habe ein paar verschiedene Versionen ausprobiert, um sicherzustellen, dass die Zwischenablage gelöscht wird, die aktuell kopierte Datei geschlossen wird, die Öffnungs- und Schließanimation der Master-Datei unterdrückt wird usw. Das Einzige, was bisher erfolgreich war Punkt war (was ich denke, funktioniert) Löschen der Zwischenablage.

Ich gebe zu, dies ist meine erste Venture in Visual Basic und ich bin kein professioneller Programmierer, so dass der Code wahrscheinlich nicht richtig Speicher verarbeitet.

Meine Frage ist: Können Sie einen Abschnitt (e)/Operation (en) erkennen, die den Code gegen Ende verlangsamt? Oder geben Sie zumindest eine brauchbare Erklärung dafür, warum es passieren würde? Im Allgemeinen ist mein Laptop nicht lustlos. Es ist ein HP EliteBook mit i5-Prozessor und 8 GB RAM, so dass ich mir nicht vorstellen kann, dass es ein Ressourcenproblem ist.

Ich habe den Code und alle Verweise auf persönliche Verzeichnisse bereinigt und es unten veröffentlicht.

Vielen Dank im Voraus für die Hilfe.

Sub MultiCSV_to_Tabs() 
Dim vaFiles As Variant 
Dim i As Long 
Dim wbkToCopy As Workbook 
Dim wbkToPaste As Workbook 

vaFiles = Application.GetOpenFilename("CSV Files (*.csv), *.csv", _ 
      Title:="Select files", MultiSelect:=True) 

'User_Created_File = "PLACE YOUR DIRECTORY AND FILE NAME IN BETWEEN THESE QUOTATION MARKS" 

If IsArray(vaFiles) Then 
    For i = LBound(vaFiles) To UBound(vaFiles) 

     'Open the first CSV file in the list of selections 
     Set wbkToCopy = Workbooks.Open(Filename:=vaFiles(i)) 

     'Split the vaFiles variable on backslashes to dissect the PathName and FileName 
     SplitFileName = Split(vaFiles(i), "\") 

     'Go find the last entry in the SplitFileName variable. This should be the exported file name we selected. 
     ExportedCSVFileName = SplitFileName(UBound(SplitFileName)) 

     'Select all cells and copy that selection 
     wbkToCopy.Application.DisplayAlerts = False 
     Cells.Select 
     Selection.Copy 

     'Close the current workbook without saving changes 
     wbkToCopy.Close savechanges:=False 

     'Open the summary workbook 
     Set wbkToPaste = Workbooks.Open(User_Created_File) 

     'Add a new tab to the end of the last tab 
     Sheets.Add After:=Sheets(Sheets.Count) 

     'Define new sheetname using the parsed filename from the workbook 
     shtname = Mid(ExportedCSVFileName, 17, 25) 
     ActiveSheet.Name = shtname 

     'Paste the selection we copied earlier 
     wbkToPaste.Application.DisplayAlerts = False 
     ActiveSheet.Paste 

     wbkToPaste.Application.CutCopyMode = False 

     'Close the summary workbook and save the changes. Go to the next file in the array. 
     wbkToPaste.Close savechanges:=True 

    Next i 

End If 

Set wbkToCleanUp = Workbooks.Open(User_Created_File) 
Sheets("Sheet1").Delete 
wbkToCleanUp.Close savechanges:=True 
MsgBox ("Copy/Paste complete") 

End Sub 

Answer 1

Cells.Select nimmt eine Menge Speicher. Finde den tatsächlichen Bereich des Blattes und kopiere das.

Für Beispiel

Sub Sample() 
    Dim ws As Worksheet 
    Dim Lrow As Long, LCol As Long 
    Dim rng As Range 

    Set ws = Sheet1 

    With ws 
     '~~> Find Last row which has data 
     Lrow = .Cells.Find(What:="*", _ 
       After:=wks.Range("A1"), _ 
       Lookat:=xlPart, _ 
       LookIn:=xlFormulas, _ 
       SearchOrder:=xlByRows, _ 
       SearchDirection:=xlPrevious, _ 
       MatchCase:=False).Row 

     '~~> Find Last column which has data      
     LCol = .Cells.Find(What:="*", _ 
       After:=wks.Range("A1"), _ 
       Lookat:=xlPart, _ 
       LookIn:=xlFormulas, _ 
       SearchOrder:=xlByColumns, _ 
       SearchDirection:=xlPrevious, _ 
       MatchCase:=False).Column 

     Set rng = .Range("A1:" & Split(Cells(, LCol).address, "$")(1) & Lrow) 

     rng.Copy 

     '~~> Paste where you want 
    End With 
End Sub 

auch nicht schließen Sie die Datei, bevor Sie es einfügen. Sie müssen auch beim Einfügen vorsichtig sein. Setzen Sie den Befehl Copy eine Zeile vor dem Einfügen. Manchmal klärt sich die Zwischenablage und Sie können ein Problem haben.