VBAマクロ実行時間が長すぎます

Question

私はメインサブから呼び出されるいくつかのサブプログラムを記述しました。個々のサブシステムは非常に迅速に実行され、ほとんどが瞬時に実行されます（テーブルの大量のデータのためにDoFindサブが実行されるまでに数秒かかる）が、メインサブを実行すると実行に1分かかります。なぜこのような場合のアイデアやヒント？

VBAに関する経験はあまりありませんでした（すべて過去1週間で学習されています）。そこに使用される他のマクロがありますが、でも、テストサブが約1分かかりますので、彼らは表示されません

Sub DoFind() 

    Dim i As Long 

    i = 1 

     Do While Sheets("Temp").Cells(i, "A").Value <> Empty 

       Dim BearingArray(6) As String 


       BearingArray(0) = Sheets("Temp").Cells(i, "A").Value 
       BearingArray(1) = Sheets("Temp").Cells(i, "B").Value 
       BearingArray(2) = Sheets("Temp").Cells(i, "C").Value 
       BearingArray(3) = Sheets("Temp").Cells(i, "D").Value 
       BearingArray(4) = Sheets("Temp").Cells(i, "E").Value 
       BearingArray(5) = Sheets("Temp").Cells(i, "F").Value 
       BearingArray(6) = Sheets("Temp").Cells(i, "G").Value 


       With Sheets("Calculations") 
        .Cells(17, "K").Value = BearingArray(0) 
        .Cells(19, "O").Value = BearingArray(1) 
        .Cells(20, "O").Value = BearingArray(2) 
        .Cells(23, "O").Value = BearingArray(3) 
        .Cells(22, "O").Value = BearingArray(4) 
        .Cells(26, "O").Value = BearingArray(5) 
        .Cells(17, "L").Value = BearingArray(6) 
       End With 

       i = i + 1 

        If Sheets("Calculations").Cells(17, "M").Value = "PASS" Then 
     Exit Do 
        Else 
        End If 
     Loop 
        If Sheets("Temp").Cells(i, "A").Value = Empty Then 
         MsgBox "No available bearing." 


        End If 


End Sub 

---

Sub Create_Sheet_Temp() 

    ThisWorkbook.Sheets.Add 
    ActiveSheet.Name = "Temp" 

' This creates a new worksheet called "Temp" 

End Sub 

---

​​

---

Sub test() 
    Create_Sheet_Temp 
    Copy_Paste 
    DoFind 

End Sub 

Answer 1

あなたはスピードアップすることができますループの前に変数にワークシートを格納することによってコードを作成します。

Dim TempWS as Worksheet 
Dim CalcWS as Worksheet 
set tempws= Sheets("Temp") 
set CalcWS=Sheets("Calculations") 

また、ループ外に配列を宣言します。また、数値列インデックスを使用することをお勧めします。コピーしようとトンの使用のために ：

Sheets("Temp").Cells(i, "G").Value 

にTempWS.Cells（私は、7）空の状況と比較する.Valueの

は、

... <> "" 

EDITしてみてください、常に最良の選択ではありませんCopyメソッドのdestinationパラメーターヘルプから例：エラーがない場合は

Worksheets("Sheet1").Range("A1:D4").Copy _ 
    destination:=Worksheets("Sheet2").Range("E5")