Excel VBA：セルに配列値を設定するのが非常に遅い

Question

QuickBooksエクスポートのデータフォーマットをいくつか実行しようとしていますが、1ステップは非常に遅いです。私は "出力"と呼ばれるシートを持っていますが、これはすべてのエントリが目的のフォーマットでレイアウトされていますが、「マップ」と呼ばれる別のシートで使用するだけで十分です。

これまでのすべては数式で行われ、その部分はうまく動作します。私は全体のエントリをループし、関連する情報を「出力」から5つの異なる配列にプルする小さなスクリプトを書いた。次に、それらの配列をループバックして、「マップ」内の適切な列にセルを挿入します。

私のスクリプトは、配列にすばやく移入しますが、セルの移入には非常に時間がかかります。私はforループを使って配列を繰り返し、各繰り返しには約3秒かかります。これは、何千ものエントリを扱う際に非常に長い時間です。

Sub Prettify() 

    Dim numbers() 
    Dim catagories() 
    Dim classes() 
    Dim subclasses() 
    Dim values() 

    Dim count As Integer 

    count = 2 

    ' The upper bounds of the loop is a calculation of the number of entries we will access 

    For i = 2 To (Sheets("Data").Cells(7, 8).Value * Sheets("Data").Cells(4, 3).Value + 2) 


     If (Sheets("Output").Cells(i, 1).Value = "") Then 

      ' Do Nothing 

     Else 

      ReDim Preserve numbers(count) 
      ReDim Preserve catagories(count) 
      ReDim Preserve classes(count) 
      ReDim Preserve subclasses(count) 
      ReDim Preserve values(count) 

      count = count + 1 

      numbers(count - 2) = Val((Sheets("Output").Cells(i, 1).Value)) 
      catagories(count - 2) = Sheets("Output").Cells(i, 2).Value 

      If (Sheets("Output").Cells(i, 3).Value = 0) Then 

       classes(count - 2) = Sheets("Output").Cells(i, 4).Value 
       subclasses(count - 2) = "" 

      Else 

       classes(count - 2) = Sheets("Output").Cells(i, 3).Value 
       subclasses(count - 2) = Sheets("Output").Cells(i, 4).Value 

      End If 

      values(count - 2) = Sheets("Output").Cells(i, 5).Value 

     End If 

    Next 

    MsgBox (numbers(0)) 
    MsgBox (catagories(0)) 

    Sheets("Map").Activate 

    ' This next part is slow 

    For j = 2 To count 

     Sheets("Map").Cells(j, 1).Value = numbers(j - 2) 
     Sheets("Map").Cells(j, 2).Value = catagories(j - 2) 
     Sheets("Map").Cells(j, 3).Value = classes(j - 2) 
     Sheets("Map").Cells(j, 4).Value = subclasses(j - 2) 
     Sheets("Map").Cells(j, 5).Value = values(j - 2) 

    Next 

End Sub 

約3年前の記事で私と同様の問題がありましたが、使用した修正は私の例には当てはまりませんでした。私はメッセージボックスを使ってさまざまな時点でコードをテストし、最後のforループの5つの割り当て手順はそれぞれ同じように遅いです。思考？

Answer 1

私はこの問題を抱えていました。問題は、コードが順番に各セルにアクセスしていることです。画面をオフにするとイベントが役立ちますが、大規模な配列では遅くて窮屈な状態になります。

解決策は、すべてを一度にセルにダンプすることです。これを実現するには、多次元配列を使用する必要があります。それは本当に複雑に聞こえるが、一度それをあなたの頭の周りに取得していない。

同じように、ワークブックからデータを取得しているように見えます。

ここでは、それを並べ替えるべきコードがありますが、それは本当にシンプルに見えますが、実際には機能します。

Dim v_Data() as variant 
Dim range_to_Load as range 
Dim y as long, x as long 
'set a range or better still use a list object 
set range_to_Load = thisworkbook.sheets("Data").Range("A1:F100") 
'Load the range into a variant array. 
with range_to_Load 
    redim v_data(1 to .rows.count, 1 to .columns.count) 
    v_data = .value 
end with 
' v_data now holds all in the range but as a multidimentional array 
' to access it its going to be like a grid so 
v_data(row in the range, column in the range) 
'Loop through the array, I'm going to covert everything to a string then 
'dump it in the Map sheet you have 
' you should avoid x,y as variables however this is a good use as they are coordinate values. 
'lbound and ubound will loop y though everything by row as it is the first dimension in the array. 
For y = lbound(v_data) to ubound(v_data) 
    ' next we are going to do the same but for the second dimention 
    For x = lbound(v_data,2) to ubound(v_data,2) 
     vdata(y,x) = cstr(v_data(y,x)) 
    Next x 
Next y 
'We have done something with the array and now want to put it somewhere, we could just drop it where we got it from to do this we would say 
range_to_Load.value = v_data 
' to put it else where 
thisworkbook.sheets("Map").range("A1").resize(ubound(v_data), ubound(v_data,2)).value = v_data 

これで問題が解決するはずです。これで多くのことができます。多次元アレイで読み上げると、チップピアソンはいつも言っていることがたくさんあり、助けになるでしょう。

アレイ内のように、巨大なセットを数分で処理するのではなく、すべてをメモリ内で処理することができます。データを取得して再びドロップすると、ワークブックへの唯一のアクセスが得られます。コード。

Answer 2

あなたのコードが破損した場合、私はあなたになっているので、今、あなたは、問題を持っています

Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 
ActiveSheet.DisplayPageBreaks = True 

を追加し、あなたのコード

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 
ActiveSheet.DisplayPageBreaks = False 

と終了時の開始時にこれを使用してみてください計算を手動にする。したがって、エラーハンドラを追加する必要があります。これは少し複雑すぎる場合、また

On Error GoTo ErrHandler 

そして、最後にを追加し、上部にあるので、画面が1

を更新し、すべてのバーを削除、追加：

Exit Sub 
ErrHandler: 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 
    ActiveSheet.DisplayPageBreaks = True 

End Sub 

を私はこれが役に立てば幸い。

Answer 3

多次元配列、Rangeオブジェクト、および異なる種類の細胞集団を使用してプロセスをスピードアップすることを提案しました。彼らは働きました、そして、以下は、すぐに動作し、同時に不要なエントリを削除する最終的なプロジェクトコードです。

Sub Prettify() 

Dim values() As Variant 
Dim usableRange As Range 
Dim rangeSelection As String 
Dim entryNumber As Long 
Dim count As Long 

count = 0 

entryNumber = Sheets("Data").Cells(4, 3).Value * Sheets("Data").Cells(7, 8).Value 

rangeSelection = "A2:E" & (entryNumber + 1) 

Set usableRange = Sheets("Output").Range(rangeSelection) 

For i = 1 To entryNumber 

    If Sheets("Output").Cells(i, 1) = "" Then 

    Else 

     count = count + 1 

    End If 

Next 

ReDim values(count, 5) 
count = 0 

For i = 1 To entryNumber 

    If usableRange.Cells(i, 1) = "" Then 

    Else 

     values(count, 0) = usableRange.Cells(i, 1).Value 
     values(count, 1) = usableRange.Cells(i, 2).Value 

     If usableRange.Cells(i, 3).Value = 0 Then 

      values(count, 2) = usableRange.Cells(i, 4).Value 
      values(count, 3) = "" 

     Else 

      values(count, 2) = usableRange.Cells(i, 3).Value 
      values(count, 3) = usableRange.Cells(i, 4).Value 

     End If 

     values(count, 4) = usableRange.Cells(i, 5).Value 

     count = count + 1 

    End If 

Next 

Sheets("Map").Range("A2").Resize(UBound(values), 5).Value = values 

End Sub 

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