VBA応用(転記の記述方法による処理時間の比較)

最近はCPUなどハードウェアの処理能力が高くなったので、処理効率をあまり考えなくても運用上で問題が起きることはあまりないかも知れません。ですが、記述方法によってどの位違うものかを確認してみましょう。

処理そのものは、セル範囲の単純な転記です。

(画像をクリックすると、このサンプルがダウンロードできます)
シートは「Sheet1」「Sheet2」のふたつです。この「Sheet1」から「Sheet2」へ「$A$1:$D$50000」のセル範囲を単純に移送するだけのものです。
※皆さんもダウンロードして、確認してみて下さい。

ここで紹介するのは、「$A$1:$D$50000」のセル範囲を一気に転記する記述が4種類と、1行ずつ転記する記述が4種類です。もちろん、「セル範囲を一気に転記」の方が速いに決まっているのですが、セル範囲が1回で特定できないようなケースもありますから、行単位で繰り返す場合に効率が良い方法も確認しておく必要があると考えて用意しています。このサンプルのような場合には「セル範囲を一気に転記」させれば良いだけのことです。

シート上の何もデータが無いと、結果の確認にならないので、あらかじめ「$A$1:$D$50000」のセル範囲にランダムな数値を投入するマクロを用意していますので、比較作業を始める前に、
ランダム値をセットするマクロの起動
この「SET_RANDOM」を起動させて下さい。処理が完了すると処理時間が表示され、
ランダム値のセット結果

このようにA列からD列まで50000行にランダムな数値がセットされます。

では、まず、8種類の記述方法を説明しておきます。全て、転記元、転記先ともに行数、列数を揃えて転記しているので、意図と違う繰り返しが起きたりすることはありません。

①

マクロの記録を行なうと記録されるような、単純な「コピー」「貼り付け」です。


'***************************************************************************************************
'* 処理名　：Let_CopyAndPaste
'* 機能　　：①[セル範囲全体転記]Copy→Paste
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_CopyAndPaste()
    '-----------------------------------------------------------------------------------------------
    ' 画面描画停止
    Call GP_SCUPD_STOP
    '-----------------------------------------------------------------------------------------------
    Worksheets(g_cnsSh1).Range(g_cnsCopyRange).Copy                 ' コピー
    Worksheets(g_cnsSh2).Paste                                      ' 貼り付け
    g_xlAPP.CutCopyMode = False                                     ' クリップボード解除
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開＋処理結果表示
    Call GP_SCUPD_START
End Sub

自動記録で「コピー」「貼り付け」を行ない、Select,Selectionをやめるように修正すると、こんなコードになると思います。

②

コピーメソッドで引数「Destination」を使うものです。この方法はクリップボードを経由しません。


'***************************************************************************************************
'* 処理名　：Let_CopyAndPaste2
'* 機能　　：②[セル範囲全体転記]Copy(Dest)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_CopyAndPaste2()
    '-----------------------------------------------------------------------------------------------
    ' 画面描画停止
    Call GP_SCUPD_STOP
    '-----------------------------------------------------------------------------------------------
    Worksheets(g_cnsSh1).Range(g_cnsCopyRange).Copy _
        Destination:=Worksheets(g_cnsSh2).Range(g_cnsCopyRange)
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開＋処理結果表示
    Call GP_SCUPD_START
End Sub

※引数「Destination」は元々第1引数なので、「Destination:=」を省略して書いてしまう人が多いと思いますが、省略した場合、各メソッドの引数をその記述順まで熟知していないと、何を渡しているか解らないという問題が発生します。一般的なコーディング規約では省略不可にしているケースが多いと思います。

③

Rangeオブジェクトをセル範囲で指定しての値の転記です。


'***************************************************************************************************
'* 処理名　：Let_EqualValue
'* 機能　　：③[セル範囲全体転記]Range指定で一回でValue転記
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_EqualValue()
    '-----------------------------------------------------------------------------------------------
    ' 画面描画停止
    Call GP_SCUPD_STOP
    '-----------------------------------------------------------------------------------------------
    Worksheets(g_cnsSh2).Range(g_cnsCopyRange).Value = _
        Worksheets(g_cnsSh1).Range(g_cnsCopyRange).Value
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開＋処理結果表示
    Call GP_SCUPD_START
End Sub

計算式でおなじみのA1参照形式でセル範囲を示す文字列式を使ってセル範囲を特定しています。

④

Rangeオブジェクトの指定にCellsプロパティでセル範囲の左上、右下のセル位置を指定し矩形転記する方法です。


'***************************************************************************************************
'* 処理名　：Let_EqualValue2
'* 機能　　：④[セル範囲全体転記]Range指定で一回で移送(Cells+Value)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_EqualValue2()
    '-----------------------------------------------------------------------------------------------
    Dim objSh1 As Worksheet                                         ' Sheet1シート
    Dim objSh2 As Worksheet                                         ' Sheet2シート
    ' 画面描画停止
    Call GP_SCUPD_STOP
    Set objSh1 = Worksheets(g_cnsSh1)
    Set objSh2 = Worksheets(g_cnsSh2)
    '-----------------------------------------------------------------------------------------------
    objSh2.Range(objSh2.Cells(1, 1), objSh2.Cells(50000, 4)).Value = _
        objSh1.Range(objSh1.Cells(1, 1), objSh1.Cells(50000, 4)).Value
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開＋処理結果表示
    Call GP_SCUPD_START
End Sub

ここまでが、セル範囲を1回で転記させる方法です。

⑤

ここからは、同じテストデータですが、あえて1行ずつを転記させてみます。
実際は、連続していないセル範囲の転記の場合に利用する方法ですが、ちょうどデータがあるので参考までに処理してみます。
まずは通常のA1参照形式での計算式でセル範囲を表記する文字列を使用して転記させる方法です。


'***************************************************************************************************
'* 処理名　：Let_CopybyRows1
'* 機能　　：⑤[行単位転記]Rangeで文字列編集(値転記)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_CopybyRows1()
    '-----------------------------------------------------------------------------------------------
    Dim objSh1 As Worksheet                                         ' Sheet1シート
    Dim objSh2 As Worksheet                                         ' Sheet2シート
    Dim lngRow As Long                                              ' 行INDEX
    Dim strRange As String                                          ' セル範囲指定文字列
    ' 画面描画停止
    Call GP_SCUPD_STOP
    Set objSh1 = Worksheets(g_cnsSh1)
    Set objSh2 = Worksheets(g_cnsSh2)
    '-----------------------------------------------------------------------------------------------
    For lngRow = 1 To 50000
        strRange = "$A$" & CStr(lngRow) & ":$D$" & CStr(lngRow)
        objSh2.Range(strRange).Value = objSh1.Range(strRange).Value
    Next lngRow
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開＋処理結果表示
    Call GP_SCUPD_START
End Sub

計算式でおなじみのA1参照形式でセル範囲を示す文字列式を使ってセル範囲を特定しています。1行毎に文字列式を編集し直すため、不利かも知れません。

⑥

今度は、Cellsプロパティを使って転記セル範囲の左上、右下セル位置を指定し矩形転記する方法です。(このケースは1行の左端、右端セルになります)


'***************************************************************************************************
'* 処理名　：Let_CopybyRows2
'* 機能　　：⑥[行単位転記]Rangeで矩形範囲指定(値転記)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_CopybyRows2()
    '-----------------------------------------------------------------------------------------------
    Dim objSh1 As Worksheet                                         ' Sheet1シート
    Dim objSh2 As Worksheet                                         ' Sheet2シート
    Dim lngRow As Long                                              ' 行INDEX
    ' 画面描画停止
    Call GP_SCUPD_STOP
    Set objSh1 = Worksheets(g_cnsSh1)
    Set objSh2 = Worksheets(g_cnsSh2)
    '-----------------------------------------------------------------------------------------------
    For lngRow = 1 To 50000
        objSh2.Range(objSh2.Cells(lngRow, 1), objSh2.Cells(lngRow, 4)).Value = _
            objSh1.Range(objSh1.Cells(lngRow, 1), objSh1.Cells(lngRow, 4)).Value
    Next lngRow
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開＋処理結果表示
    Call GP_SCUPD_START
End Sub

「Cellsプロパティは遅い」という人がいますが、どうでしょう。

⑦

前項と似ていますが、今度は起点となる左上のセルを指定し、そこからｎ行分ｎ列分を右下方向へ取った矩形範囲を指定して矩形転記する方法です。今回のように列数が固定の場合は不利に働きますが、行数列数が不定となる処理ではこの方法が有効です。


'***************************************************************************************************
'* 処理名　：Let_CopybyRows3
'* 機能　　：⑦[行単位転記]起点Range＋Resize指定(値転記)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_CopybyRows3()
    '-----------------------------------------------------------------------------------------------
    Dim objSh1 As Worksheet                                         ' Sheet1シート
    Dim objSh2 As Worksheet                                         ' Sheet2シート
    Dim lngRow As Long                                              ' 行INDEX
    ' 画面描画停止
    Call GP_SCUPD_STOP
    Set objSh1 = Worksheets(g_cnsSh1)
    Set objSh2 = Worksheets(g_cnsSh2)
    '-----------------------------------------------------------------------------------------------
    For lngRow = 1 To 50000
        objSh2.Range("$A$" & CStr(lngRow)).Resize(, 4).Value = _
            objSh1.Range("$A$" & CStr(lngRow)).Resize(, 4).Value
    Next lngRow
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開
    Call GP_SCUPD_START
End Sub

⑧

前項と同じですが、左上セルを掴むのに、Cellsプロパティを使ってみました。


'***************************************************************************************************
'* 処理名　：Let_CopybyRows4
'* 機能　　：⑧[行単位転記]起点Cells＋Resize指定(値転記)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年11月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月22日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub Let_CopybyRows4()
    '-----------------------------------------------------------------------------------------------
    Dim objSh1 As Worksheet                                         ' Sheet1シート
    Dim objSh2 As Worksheet                                         ' Sheet2シート
    Dim lngRow As Long                                              ' 行INDEX
    ' 画面描画停止
    Call GP_SCUPD_STOP
    Set objSh1 = Worksheets(g_cnsSh1)
    Set objSh2 = Worksheets(g_cnsSh2)
    '-----------------------------------------------------------------------------------------------
    For lngRow = 1 To 50000
        objSh2.Cells(lngRow, 1).Resize(, 4).Value = _
            objSh1.Cells(lngRow, 1).Resize(, 4).Value
    Next lngRow
    '-----------------------------------------------------------------------------------------------
    ' 画面描画再開＋処理結果表示
    Call GP_SCUPD_START
End Sub

さて、では処理結果を見てみましょう。絶対的な時間はコンピュータの処理能力やその時点の状態にもよりますので、それぞれの処理が「どの位違うか」で判断して下さい。

№	処理内容	1回目	2回目	3回目	4回目	結果考察
①	単純な「コピー」「貼り付け」	0.109秒	0.094秒	0.109秒	0.030秒	結構速い
②	コピーメソッドで引数「Destination」を使う	0.047秒	0.063秒	0.062秒	0.022秒	一番速い
③	セル範囲で指定しての値の転記	0.187秒	0.172秒	0.328秒	0.109秒	今まで速いと思っていたのですが、Copyメソッドの方が速かった。
④	Cellsプロパティで左上、右下のセル位置を指定	0.188秒	0.172秒	0.328秒	0.104秒	同上
⑤	A1参照形式でセル範囲を表記する文字列で転記	2.563秒	2.640秒	7.859秒	0.744秒	この場合は、文字列編集の方が速い！？
⑥	Cellsプロパティを使って左上、右下セル位置を指定し転記	2.796秒	3.000秒	6.204秒	0.552秒	③④と違い、若干遅い結果となる。Celeron機は⑤より速い。
⑦	起点となる左上のセルからｎ行分ｎ列分を取った範囲を指定	3.140秒	3.156秒	10.094秒	0.800秒	毎行同サイズでResizeさせるのは不利です。
⑧	⑦と同じですが、左上セルにCellsプロパティを使用	3.063秒	2.906秒	6.984秒	0.645秒	Rangeでセルを文字列式で指定するより、Cellsプロパティで座標位置を指定する方が速い！？

・常駐ソフト(ウィルスソフトや付箋紙)、ブラウザ、メールソフトが動いた状態のPeitium4マシンで計測しました。
・その時点での状態の影響を確認するため、該当ブックは開いたままで、「Sheet2」は毎回クリアして、順に計測し、2回目は逆順で処理しています。
3回目は別PC(Celeron1.7G)による結果です。(いずれもかなり古いデータです)
4回目も別PC(第8世代Core i7)による結果です。 (これは時代の差です)
※この処理では、前後に画面上のコンディションを調整する記述を通しているので、全般に処理能力が低いコンピュータの方が優劣の差が大きく現われると思います。