VBA100本ノック 33本目：マクロ記録の改修

この記事から得るもの

１　今回のお題

「このVBAはマクロの記録から作ったのですが、件数の数値を変更してから実行しなければならず、データ件数も多くて何分も時間がかかりとても困っています。なんとかしてもらえないでしょうか?」
こう頼まれました。VBAを書いて対応してあげましょう。

f:id:bimori466:20201210213414p:plain

Sub ノック33_ソース()

Sheets("データ").Select
For i = 2 To 3500

DoEvents

Range("D" & i).Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(VLOOKUP(RC[-2],マスタ!C[-3]:C[-1],2,FALSE),"""")"
Range("E" & i).Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(VLOOKUP(RC[-3],マスタ!C[-4]:C[-2],3,FALSE),"""")"
Range("F" & i).Select
ActiveCell.FormulaR1C1 = _
    "=RC[-1]*RC[-3]"
Range("D" & i & ":F" & i).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Next
Range("A1").Select

End Sub

２　今回のお題の意図

処理速度をあげる処理を追加。必要な分だけ処理する。

３　回答

記録マクロのソースコードを動かしてみるとわかるのですが、「For i = 2 To 3500」とループ回数を決めてしまっています。そのため、データが入力されている分だけ処理をする。加えて、処理速度をあげるコードを追加してあげます。

私の回答

Sub ノック33_1()

Dim ws As Worksheet: Set ws = Worksheets("データ")

'処理速度を上げるやつ設定
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Sheets("データ").Select
For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row  '最終行の取得
Range("D" & i).Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(VLOOKUP(RC[-2],マスタ!C[-3]:C[-1],2,FALSE),"""")"
Range("E" & i).Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(VLOOKUP(RC[-3],マスタ!C[-4]:C[-2],3,FALSE),"""")"
Range("F" & i).Select
ActiveCell.FormulaR1C1 = _
    "=RC[-1]*RC[-3]"
Range("D" & i & ":F" & i).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Next
Range("A1").Select


'処理速度を上げるやつ設定終了
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub