マクロVBAの高速化・速度対策の具体的手順と検証

最終更新日：2019-06-16

マクロVBAの高速化・速度対策の具体的手順と検証

マクロVBAが遅い・重いという相談が非常に多いので、

遅い・重いマクロVBAを高速化・速度対策する場合の具体的な手順をここに解説・検証します。

マクロVBAの速度に関する記事は既にいくつか書いています。

特に、以下はぜひお読みください。

エクセルVBAのパフォーマンス・処理速度に関するレポート

ExcelのマクロVBAは遅い・重いと良く言われることが多いようですが、マクロVBAが遅い・重いのではなく、その書かれたVBAコードが遅いのです。正しい高速化・速度対策をしたコードなら、それほど遅くはありません。むしろ、巨大なスプレッドシートを扱っている事を考えれば、驚異的なパフォーマンスとも言えるのです。

ここでのまとめとしては、


  
    
      まずやるべき事は、


Excel 2010 のパフォーマンス・・・VBA マクロの高速化

VBA高速化テクニック・・・セルを配列に入れる


この部分になります。


マクロVBAが遅いと相談されて、コードを確認した場合、


ほとんどは、以下の対処で劇的に速くなります。


・Application.ScreenUpdatingの停止・Applicationの主要プロパティ ・ScreenUpdating（マクロVBAの高速化） ・DisplayAlerts（警告停止） ・Interactive（ユーザー操作の禁止） ・Calculation（計算方法） ・StatusBar ・Cursor ・その他 
・Application.Calculationを手動・Applicationの主要プロパティ ・ScreenUpdating（マクロVBAの高速化） ・DisplayAlerts（警告停止） ・Interactive（ユーザー操作の禁止） ・Calculation（計算方法） ・StatusBar ・Cursor ・その他 
・セルを配列に入れる・セル範囲⇔配列の基本VBA ・使用例 ・配列およびマクロVBAの高速化に関するページ  


また、単なるテクニックではなく、正しいロジック・アルゴリズムによっても大きく変わります。


【奥義】大量データでの高速VLOOKUP


この記事は、マクロVBAではなく、ワークシート関数についてですが、


考え方の問題として、非常に重要です。


データの検索はVBAでは頻繁に行われます。


データを並べ替え、適切なアルゴリズムで格段に速くなります。

VBAの速度対策としては、ここに書いた事がほとんど全てなのですが、

より細かい点も含め、具体的な手順として解説します。

以下の表を使い解説します。

Sheet1

元データのシートです。
データは１万件、2～10002行まで入っています。
C2 =VLOOKUP($B2,Sheet3!$A:$D,2,0)
E2 =C2*D2
全行に同様の数式が入れてあります。

Sheet2

結果出力のシートです。

Sheet3

商品マスタのシートです。
とりあえず１０件入れました。
D2 =SUMIF(Sheet1!B:B,A2,Sheet1!D:D)
E2 =SUMIF(Sheet1!B:B,A2,Sheet1!E:E)
全行に同様の数式が入れてあります。

作るVBAの内容

Sheet2のB1の商品と同じ商品をSheet1より抽出し、4行目以降に出力します。
出力されたデータ範囲には罫線を引きます。
A列は、日付形式の表示形式を設定
E列は、カンマ編集

検証環境

WindowsXP
Core2DUO 1.66GHz
メモリ 1GB
Excel2010
かなり古いPCです・・・

以下11通りのVBAでかかった時間を実測しました。
動作の安定度等もある為、若干の違いは誤差として判断して下さい。
なお、実測は3回以上の平均を出しています。
各VBAの先頭と最後に
Debug.Print Timer
を入れ、その差を持って所要時間としています。

test1

まずは、これはヒドイというVBAから、
さすがに、このサイトを見ている人では、
こんなコードを書く人はいないと信じたい。


  
    
      Sub test1()

      　　Debug.Print Timer

      　　Dim i, j

      　　Sheets("Sheet2").Select

      　　Range("A3").CurrentRegion.Offset(1).Clear

      　　j = 4

      　　Sheets("Sheet1").Select

      　　For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If Cells(i, 2) = Worksheets("Sheet2").Range("B1") Then

      　　　　　　Range("A" & i & ":" & "E" & i).Select

      　　　　　　Selection.Copy

      　　　　　　Sheets("Sheet2").Select

      　　　　　　Range("A" & j).Select

      　　　　　　ActiveSheet.Paste

      　　　　　　Range("A" & j).NumberFormatLocal = "yyyy/m/d"

      　　　　　　Range("E" & j).NumberFormatLocal = "#,##0"

      　　　　　　Range("A" & i & ":" & "E" & i).Borders.LineStyle = xlContinuous

      　　　　　　Sheets("Sheet1").Select

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　Sheets("Sheet2").Select

      　　Debug.Print Timer

      End Sub

所要時間：46秒

これはもう、どうしようもないですね。

test2

さすがに、tes1のコードなら、
Application.ScreenUpdating = False
これ一発で速くなります。


  
    
      Sub test2() '10

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Dim i, j

      　　Sheets("Sheet2").Select

      　　Range("A3").CurrentRegion.Offset(1).Clear

      　　j = 4

      　　Sheets("Sheet1").Select

      　　For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If Cells(i, 2) = Worksheets("Sheet2").Range("B1") Then

      　　　　　　Range("A" & i & ":" & "E"
      & i).Select

      　　　　　　Selection.Copy

      　　　　　　Sheets("Sheet2").Select

      　　　　　　Range("A" & j).Select

      　　　　　　ActiveSheet.Paste

      　　　　　　Range("A" & j).NumberFormatLocal = "yyyy/m/d"

      　　　　　　Range("E" & j).NumberFormatLocal = "#,##0"

      　　　　　　Range("A" & i & ":" & "E" & i).Borders.LineStyle = xlContinuous

      　　　　　　Sheets("Sheet1").Select

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：10秒

断然速くなりました。

とにかく、VBAが遅いと感じたら、真っ先に、
Application.ScreenUpdating = False
これが入っているかを確認して下さい。

しかし、test2のコードはあんまりです。
問題点
・Sheetsの.Select
・RangeのSelect
・Rangeで("A" & j)
とにかく、この３点はダメです。
最期の
Rangeで("A" & j)
これは、測度も遅いのですが、何より見苦しいので止めましょう。
しかし、このようなVBAコードを教えている所があるらしいことを聞いています。
嘆かわしい事この上ない。

test3

では、普通に初心者的な書き方をしてみると


  
    
      Sub test3()

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Dim i, j

      　　Worksheets("Sheet2").Range("A3").CurrentRegion.Offset(1).Clear

      　　j = 4

      　　For i = 1 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If Worksheets("Sheet1").Cells(i, 2) = Worksheets("Sheet2").Range("B1") Then

      　　　　　　Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)

      　　　　　　Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)

      　　　　　　Worksheets("Sheet2").Cells(j, 3) = Worksheets("Sheet1").Cells(i, 3)

      　　　　　　Worksheets("Sheet2").Cells(j, 4) = Worksheets("Sheet1").Cells(i, 4)

      　　　　　　Worksheets("Sheet2").Cells(j, 5) = Worksheets("Sheet1").Cells(i, 5)

      　　　　　　Worksheets("Sheet2").Cells(j, 1).NumberFormatLocal = "yyyy/m/d"

      　　　　　　Worksheets("Sheet2").Cells(j, 5).NumberFormatLocal = "#,##0"

      　　　　　　Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(j, 1), Worksheets("Sheet2").Cells(j, 5)).Borders.LineStyle = xlContinuous

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：3.03秒

まあ、普通の結果です。

しばらくウエイトカーソルになりますが、遅くて困ると言うほどではないですね。

test4

では、いよいよ本格的な速度対策です。

このブックには、計算式が入っていますので、計算を止めてみましょう。


  
    
      Sub test4() '3.01

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Dim i, j

      　　Worksheets("Sheet2").Range("A3").CurrentRegion.Offset(1).Clear

      　　j = 4

      　　For i = 1 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If Worksheets("Sheet1").Cells(i, 2) = Worksheets("Sheet2").Range("B1") Then

      　　　　　　Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)

      　　　　　　Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)

      　　　　　　Worksheets("Sheet2").Cells(j, 3) = Worksheets("Sheet1").Cells(i, 3)

      　　　　　　Worksheets("Sheet2").Cells(j, 4) = Worksheets("Sheet1").Cells(i, 4)

      　　　　　　Worksheets("Sheet2").Cells(j, 5) = Worksheets("Sheet1").Cells(i, 5)

      　　　　　　Worksheets("Sheet2").Cells(j, 1).NumberFormatLocal = "yyyy/m/d"

      　　　　　　Worksheets("Sheet2").Cells(j, 5).NumberFormatLocal = "#,##0"

      　　　　　　Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(j, 1), Worksheets("Sheet2").Cells(j, 5)).Borders.LineStyle = xlContinuous

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　Application.Calculation = xlCalculationAutomatic

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：3.01秒

あまり変わりませんでした。

入れた数式が、時間のかかるものではなかったので、こんなものかもしれません。
（時間のかかる計算式を入れるのが面倒だったもので・・・）

しかし、

セルに値を入れた時に、ステータスバーに「再計算」がチラチラするようなブックなら効果は大きいです。

test5

では、時々言われる事のある、変数の型指定をしてみます。


  
    
      Sub test5() '3.01

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Dim i As Long

      　　Dim j As Long

      　　Worksheets("Sheet2").Range("A3").CurrentRegion.Offset(1).Clear

      　　j = 4

      　　For i = 1 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If Worksheets("Sheet1").Cells(i, 2) = Worksheets("Sheet2").Range("B1") Then

      　　　　　　Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)

      　　　　　　Worksheets("Sheet2").Cells(j, 2) = Worksheets("Sheet1").Cells(i, 2)

      　　　　　　Worksheets("Sheet2").Cells(j, 3) = Worksheets("Sheet1").Cells(i, 3)

      　　　　　　Worksheets("Sheet2").Cells(j, 4) = Worksheets("Sheet1").Cells(i, 4)

      　　　　　　Worksheets("Sheet2").Cells(j, 5) = Worksheets("Sheet1").Cells(i, 5)

      　　　　　　Worksheets("Sheet2").Cells(j, 1).NumberFormatLocal = "yyyy/m/d"

      　　　　　　Worksheets("Sheet2").Cells(j, 5).NumberFormatLocal = "#,##0"

      　　　　　　Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(j, 1), Worksheets("Sheet2").Cells(j, 5)).Borders.LineStyle = xlContinuous

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　Application.Calculation = xlCalculationAutomatic

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：3.01秒

まったく変わりませんでした。

この場合は、単なるカウンターだった事もあり、この程度の処理では、型指定は影響はしません。

数百万回と言うような処理をしない限り、実測されるほどの差は出ないでしょう。

とはいえ、型指定は可能な限り行うべきです。

それは、測度対策と言うより、プログラムの品質の面で指定すべきです。

test6

では、良くかかれそうなコードにしてみます。

Worksheetのオブジェクト変数とWithステートメントを使います。


  
    
      Sub test6()

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Dim i As Long

      　　Dim j As Long

      　　Dim ws1 As Worksheet

      　　Set ws1 = Worksheets("Sheet1")

      　　j = 4

      　　With Worksheets("Sheet2")

      　　　　.Range("A3").CurrentRegion.Offset(1).Clear

      　　　　For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

      　　　　　　If ws1.Cells(i, 2) = .Range("B1") Then

      　　　　　　　　.Cells(j, 1) = ws1.Cells(i, 1)

      　　　　　　　　.Cells(j, 2) = ws1.Cells(i, 2)

      　　　　　　　　.Cells(j, 3) = ws1.Cells(i, 3)

      　　　　　　　　.Cells(j, 4) = ws1.Cells(i, 4)

      　　　　　　　　.Cells(j, 5) = ws1.Cells(i, 5)

      　　　　　　　　.Cells(j, 1).NumberFormatLocal = "yyyy/m/d"

      　　　　　　　　.Cells(j, 5).NumberFormatLocal = "#,##0"

      　　　　　　　　.Range(.Cells(j, 1), .Cells(j, 5)).Borders.LineStyle = xlContinuous

      　　　　　　　　j = j + 1

      　　　　　　End If

      　　　　Next

      　　End With

      　　Application.Calculation = xlCalculationAutomatic

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：2.81秒

一定の効果は出ています。

この程度が書ければ、実務で使う上で支障ないレベルだと思います。

test7

せっかくなので、Withを使わずに、

Worksheetのオブジェクト変数のみで書いてみましょう。


  
    
      Sub test7()

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Dim i As Long

      　　Dim j As Long

      　　Dim ws1 As Worksheet

      　　Dim ws2 As Worksheet

      　　Set ws1 = Worksheets("Sheet1")

      　　Set ws2 = Worksheets("Sheet2")

      　　ws2.Range("A3").CurrentRegion.Offset(1).Clear

      　　j = 4

      　　For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If ws1.Cells(i, 2) = ws2.Range("B1") Then

      　　　　　　ws2.Cells(j, 1) = ws1.Cells(i, 1)

      　　　　　　ws2.Cells(j, 2) = ws1.Cells(i, 2)

      　　　　　　ws2.Cells(j, 3) = ws1.Cells(i, 3)

      　　　　　　ws2.Cells(j, 4) = ws1.Cells(i, 4)

      　　　　　　ws2.Cells(j, 5) = ws1.Cells(i, 5)

      　　　　　　ws2.Cells(j, 1).NumberFormatLocal = "yyyy/m/d"

      　　　　　　ws2.Cells(j, 5).NumberFormatLocal = "#,##0"

      　　　　　　ws2.Range(ws2.Cells(j, 1), ws2.Cells(j, 5)).Borders.LineStyle = xlContinuous

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　Application.Calculation = xlCalculationAutomatic

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：2.65秒

けっこう速くなっちゃいました。

なぜ速くなったかについては、かなり難しい問題になります。

ただ、とにかく、使用するシートは全て変数に入れてから処理した方が良いと言う事です。

test8

そもそも、無駄な部分、というか、もっと効率的にできる部分があります。

罫線と書式の設定は、最期にまとめて一回やれば良いですよね。

セルつまりRangeオブジェクトは、まとめて処理すると高速になります。


  
    
      Sub test8()

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Dim i As Long

      　　Dim j As Long

      　　Dim ws1 As Worksheet

      　　Dim ws2 As Worksheet

      　　Set ws1 = Worksheets("Sheet1")

      　　Set ws2 = Worksheets("Sheet2")

      　　ws2.Range("A3").CurrentRegion.Offset(1).Clear

      　　j = 4

      　　For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If ws1.Cells(i, 2) = ws2.Range("B1") Then

      　　　　　　ws2.Cells(j, 1) = ws1.Cells(i, 1)

      　　　　　　ws2.Cells(j, 2) = ws1.Cells(i, 2)

      　　　　　　ws2.Cells(j, 3) = ws1.Cells(i, 3)

      　　　　　　ws2.Cells(j, 4) = ws1.Cells(i, 4)

      　　　　　　ws2.Cells(j, 5) = ws1.Cells(i, 5)

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j - 1, 1)).NumberFormatLocal = "yyyy/m/d"

      　　ws2.Range(ws2.Cells(4, 5), ws2.Cells(j - 1, 5)).NumberFormatLocal = "#,##0"

      　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j - 1, 5)).Borders.LineStyle = xlContinuous

      　　Application.Calculation = xlCalculationAutomatic

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：0.53秒

これははっきりとした効果がありました。

セルの書式設定は、極力まとめて処理するようにして下さい。

test9

これで高速化・速度対策は終わりでしょうか？

とりあえずは、ここまで出来れば最低限のラインはクリアしてはいます。

しかし、まだまだ、これからです。

むしろ、ここからが真骨頂です。


  
    
      Sub test9()

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Dim i As Long

      　　Dim j As Long

      　　Dim strFind As String

      　　Dim ws1 As Worksheet

      　　Dim ws2 As Worksheet

      　　Set ws1 = Worksheets("Sheet1")

      　　Set ws2 = Worksheets("Sheet2")

      　　ws2.Range("A3").CurrentRegion.Offset(1).Clear

      　　strFind = ws2.Range("B1")

      　　j = 4

      　　For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If ws1.Cells(i, 2) = strFind Then

      　　　　　　ws2.Cells(j, 1) = ws1.Cells(i, 1)

      　　　　　　ws2.Cells(j, 2) = ws1.Cells(i, 2)

      　　　　　　ws2.Cells(j, 3) = ws1.Cells(i, 3)

      　　　　　　ws2.Cells(j, 4) = ws1.Cells(i, 4)

      　　　　　　ws2.Cells(j, 5) = ws1.Cells(i, 5)

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j - 1, 4)).NumberFormatLocal = "yyyy/m/d"

      　　ws2.Range(ws2.Cells(4, 5), ws2.Cells(j - 1, 5)).NumberFormatLocal = "#,##0"

      　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j - 1, 5)).Borders.LineStyle = xlContinuous

      　　Application.Calculation = xlCalculationAutomatic

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：0.35秒

検索する商品名を変数に入れて使うようにしただけです。

所要時間は、はっきりとした差が出ています。

VBAで最も時間のかかる処理は、オブジェクトの操作です。

セルはRangeオブジェクトです。

同じセル値を何度も参照する場合は、変数に入れるようにして下さい。

test10

高速化・速度対策はきりが無い程あります。

まだ、まとめて処理できる部分があります。

それは、セル値のコピー・転記の部分です。


  
    
      Sub test10()

      　　Debug.Print Timer

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Dim i As Long

      　　Dim j As Long

      　　Dim strFind As String

      　　Dim ws1 As Worksheet

      　　Dim ws2 As Worksheet

      　　Set ws1 = Worksheets("Sheet1")

      　　Set ws2 = Worksheets("Sheet2")

      　　ws2.Range("A3").CurrentRegion.Offset(1).Clear

      　　strFind = ws2.Range("B1")

      　　j = 4

      　　For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

      　　　　If ws1.Cells(i, 2) = strFind Then

      　　　　　　ws2.Range(ws2.Cells(j, 1), ws2.Cells(j, 5)).Value _

      　　　　　　　　= ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 5)).Value

      　　　　　　j = j + 1

      　　　　End If

      　　Next

      　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j - 1, 1)).NumberFormatLocal = "yyyy/m/d"

      　　ws2.Range(ws2.Cells(4, 5), ws2.Cells(j - 1, 5)).NumberFormatLocal = "#,##0"

      　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j - 1, 5)).Borders.LineStyle = xlContinuous

      　　Application.Calculation = xlCalculationAutomatic

      　　Application.ScreenUpdating = True

      　　Debug.Print Timer

      End Sub

所要時間：0.22秒

これも確実に速くなっています。

オブジェクトを操作する回数を減らせば減らすほど速くなります。

高速化・速度対策を一言で言えば、オブジェクトを操作する回数を減らすと言う事です。

test11

ある意味、究極の速度対策です。

配列を駆使します。


  
    
      Sub test11()

　　Debug.Print Timer

'　　Application.ScreenUpdating = False

'　　Application.Calculation = xlCalculationManual

　　Dim i As Long

　　Dim j As Long

　　Dim strFind As String

　　Dim myAry1

　　Dim myAry2

　　Dim maxRow As Long

　　Dim ws1 As Worksheet

　　Dim ws2 As Worksheet

　　Set ws1 = Worksheets("Sheet1")

　　Set ws2 = Worksheets("Sheet2")

　　maxRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row

      　　myAry1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxRow, 5))

　　ws2.Range("A3").CurrentRegion.Offset(1).Clear

　　strFind = ws2.Range("B1")

　　For i = LBound(myAry1, 1) To UBound(myAry1, 1)

　　　　If myAry1(i, 2) = strFind Then

　　　　　　If Not IsArray(myAry2) Then

　　　　　　　　ReDim myAry2(LBound(myAry1, 2) To UBound(myAry1, 2), 1 To 1)

　　　　　　Else

　　　　　　　　ReDim Preserve myAry2(LBound(myAry1, 2) To UBound(myAry1, 2), 1 To UBound(myAry2, 2) + 1)

　　　　　　End If

　　　　　　For j = LBound(myAry1, 2) To UBound(myAry1, 2)

　　　　　　　　myAry2(j, UBound(myAry2, 2)) = myAry1(i, j)

　　　　　　Next

　　　　End If

　　Next

　　j = UBound(myAry2, 2) + 3

　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j, 5)).Value = WorksheetFunction.Transpose(myAry2)

　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j, 1)).NumberFormatLocal = "yyyy/m/d"

　　ws2.Range(ws2.Cells(4, 5), ws2.Cells(j, 5)).NumberFormatLocal = "#,##0"

　　ws2.Range(ws2.Cells(4, 1), ws2.Cells(j, 5)).Borders.LineStyle = xlContinuous

'　　Application.Calculation = xlCalculationAutomatic

'　　Application.ScreenUpdating = True

　　Debug.Print Timer

End Sub

所要時間：0.08秒

もうすでに、コンマ以下の争いになっていたのですが、

さらに一桁下がりました。

短縮時間は小さいですが、格段に速くなっている事が分かると思います。

ここまで来れば、高速化・速度対策も一応の完了です。

ここまで来ると、

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

これらは逆に邪魔なだけで、上記でもコメントアウトしています。

つまり、これまでは、セルに１行毎に値を入れていました。

だから、１行毎に画面描画されてしまうので、これを止めました。

また、１行毎に再計算も行われてしまうので、これを止めました。

しかし、最期のVBAコードでは、一度にセルにいれているので、

これらの心配が必要ありません。

むしろ、これらのプロパティの変更時間分遅くなってしまいます。

総括

いかがでしたでしょうか。

長文を最後までお読みくださり感謝いたします。

まとめると

テスト項番	所要時間	高速化・速度対策内容
test1	46秒	シートやセルをSelectしている最悪のVBA
test2	10秒	Application.ScreenUpdating =False を追加
test3	3.03秒	シートやセルをSelectを止める
test4	3.01秒	Application.Calculation = xlCalculationManual を追加
test5	3.01秒	変数の型宣言を追加
test6	2.81秒	WithステートメントでWorksheetsを指定
test7	2.65秒	すべてオブジェクト変数に変更
test8	0.53秒	セルの書式設定を一括で設定
test9	0.35秒	何度も使うセル値（検索値）を変数に入れる
test10	0.22秒	複数セル値を１行分まとめて入れる
test11	0.08秒	配列の使用

上から順にVBAコードを確認してみて下さい。

test1とtest11では、実に500倍の違いがあります。

本来は、test1とtest2のVBAは問題外なのですが、かなり多くの方が書いているマクロでもあります。

理由は、マクロの自動記録を元に書いている、そのような書き方を教えている所があるらしい・・・

test3、test5、test6あたりは、結構やっている人は多いようです。

なので、注意点としては、

test4とtest7以降です。

test4は、今回は短縮時間はほとんどなかったのですが、

計算式の多く入ったブックでは、これが最も効果がある場合があります。

この計算を止めてない為に遅くなっている場合が、かなり多く見受けられます。

そして、通常使う分には、test9くらいまでで十分な場合が多いでしょう。

それで、もっと速くしたい場合に、配列の使用を検討して下さい。

もちろん、最初から配列を使えればそれに越したことはありませんが。

高速化・速度対策を一言で言えば、オブジェクトを操作する回数を減らすと言う事です。

その為の最終手段が配列の使用になります。

また、このような処理の場合に、Findメソッドを使う事もあるようですが、

Findメソッドも処理が遅いので、積極的に使うべきではありません。

参考

記述による処理速度の違い

・１．変数の型指定 ・2．罫線の引き方・3．行高の変更・4．配列を使用した処理・処理速度を早くする為には

速度比較決定版【Range,Cells,Do,For,For Each】

何度も言っているのですが、RangeとCellsでどっちが早いか、とか、DoとForとFor Eachでどれが早いかとか、そもそも、その議論がナンセンスなんです。以下のコードと結果を見て、各自で判断して下さい。巷の議論が、いかに無意味で、実は良く解っていないのだと言う事を、理解してもらいたい。

エクセルVBAのパフォーマンス・処理速度に関するレポート

Findメソッドを私が使わない理由

・1.処理速度が遅い・2.指定オプションがシート操作とリンクしている・「値」で検索した場合は、表示形式に依存した検索になる・最後に

記述による処理速度の違い

・１．変数の型指定・2．罫線の引き方・3．行高の変更・4．配列を使用した処理・処理速度を早くする為には

追記

上記の速度対策では語られていない速度アップ技術について、以下で解説しています。
上記の対策をしてもまだ遅い、もしくはもっと速くしたい、という事があれば、
以下の技術が適用できないか検討してみて下さい。

大量データで処理時間がかかる関数の対処方法（WorksheetFunction）

・大量データで処理時間がかかるサンプルデータ・普通にマクロVBAコ－ドを書いた場合・指定範囲を絞ってみる・配列を使って書いてみる・アルゴリズムを考えてみる・Dictionary（連想配列）を使う・大量データで処理時間がかかる関数の対処方法の最後に

大量データにおける処理方法の速度王決定戦

VBAで自動化したが、大量データ処理に時間がかかってしまう… そんな悩みが非常に多いようです、そこで、各種処理方法の速度比較を行い、どの処理方法が最も速いかを検証します。つまり、処理方法の速度王決定戦です。検証する題材としては、最も一般的な集計で行います。

遅い文字列結合を最速処理する方法について

VBAは遅い… よく聞くことですが、確かに普通にコード記述しているととても遅いことがあります、その代表の一つに、文字列結合があります、文字列結合を最速処理する方法について解説します。そもそも文字列結合は、なぜ遅いのか、String型（可変長文字列）についての基礎知識が必要です。

同じテーマ「マクロVBA技術解説」の記事

速度比較決定版【Range,Cells,Do,For,ForEach】
エクセルVBAのパフォーマンス・処理速度に関するレポート
 VBAのFindメソッドの使い方には注意が必要です
マクロVBAの高速化・速度対策の具体的手順と検証
動的2次元配列の次元を入れ替えてシートへ出力（Transpose）
大量データで処理時間がかかる関数の対処方法（SumIf）
大量データにおける処理方法の速度王決定戦
 遅い文字列結合を最速処理する方法について
 大量VlookupをVBAで高速に処理する方法について
 Withステートメントの実行速度と注意点
 IfステートメントとIIF関数とMax関数の速度比較

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
6.マクロって何？VBAって何？｜VBA入門
7.並べ替え（Sort）｜VBA入門
8.Excelショートカットキー一覧｜Excelリファレンス
9.エクセルVBAでのシート指定方法｜VBA技術解説
10.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門

ホーム
マクロVBA応用編
マクロVBA技術解説
マクロVBAの高速化・速度対策の具体的手順と検証

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA技術解説
マクロVBAの高速化・速度対策の具体的手順と検証