私のExcel VBスクリプトが遅くなる原因は何ですか？

Question

まずは少し背景：選択したディレクトリにn CSVファイルをコピーし、それぞれのデータをコピーしてnタブの「マスター」Excelワークブックファイルに貼り付ける必要がありました。私はまた、自動的にタブに何か有用な名前を付けるスクリプトが必要です。

私はFrankenstein'dが一緒にマクロ録音の組み合わせを使用して、私がここで見つけた作品と良いオール '流行のグーグルを使用しています。あまりにも多くのエラーがなくても実行されます。ただし、プロセスの最後に向かって（10以上のCSVファイルがある場合）、かなり遅くなります。

私は、クリップボードがクリアされていること、コピーされている現在のファイルが閉じられていること、マスターファイルの開閉アニメーションを抑制していることなどを確認するためにいくつかの異なるバージョンを試しました。私はクリップボードをクリアしていました。

私はこれがVisual Basicへの私の最初のベンチャーであり、プロのプログラマーではないことを認めます。そのため、コードはおそらくメモリを適切に処理しません。

私の質問はです。最後に向かってコードが遅くなっているセクションや操作を見つけることができますか？あるいは、なぜそれが起こっているのかに関して、少なくとも実行可能な説明を提供していますか？一般に、私のラップトップは恥ずかしがり屋ではありません。 i5プロセッサと8GBのRAMを搭載したHP EliteBookだから、リソースの問題だとは想像もしません。

コードと個人用ディレクトリへの参照をすべて消して下に掲載しました。

ありがとうございました。

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は、多くのメモリを消費しています。シートの実際の範囲を探し、それをコピーします。あなたはそれを貼り付ける前に、例

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 

については

はまた、ファイルを閉じないでください。貼り付ける際には注意が必要です。ペーストする前にCopyコマンドを1行入れてください。クリップボードがクリアされ、問題が発生することがあります。