基シートのB列にOKを記入／別シートマッチング
これは、検索データシートとアクティブなシートのA列を比較して、一致するセルに「OK」という文字列を書き込むエクセルマクロです。
＊アクティブシートを選択して実施
Sub 動的配列でマッチング()
Dim tate As Long
Dim rH As Range
Dim st() As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
'検索ﾃﾞｰﾀシート
Dim LastRow1 As Long
LastRow1 = ThisWorkbook.Worksheets("検索ﾃﾞｰﾀ").Cells(Rows.Count, 1).End(xlUp).Row
For tate = 0 To LastRow1
ReDim Preserve st(tate)
st(tate) = ThisWorkbook.Worksheets("検索ﾃﾞｰﾀ").Range("A2").Offset(tate).Value
Next
'アクティブシート
Dim LastRow2 As Long
LastRow2 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Columns(2).Insert
For tate = 0 To UBound(st)
For Each rH In Range("A2:A" & LastRow2)
If rH.Value = st(tate) Then
rH.Offset(, 1).Value = "OK"
End If
Next
Next
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "完了"
End Sub解説
- まず、
Dim tate As Longで変数tateを宣言しています。tateはforループのカウンターとして使用されます。 - 次に、
Dim rH As Rangeで変数rHを宣言しています。rHは検索対象のセルを表すRangeオブジェクトです。後のループで使用されます。 Dim st() As Stringで文字列型の動的配列stを宣言しています。ここではReDimステートメントで要素数0の配列として初期化されます。- 次の3つの行で、処理の最初に、スクリーンアップデートの無効化と計算モードの変更が行われます。これにより、マクロが実行される際にExcelが処理を高速化することができます。
- 次に、検索対象のデータが格納されているシートである「検索ﾃﾞｰﾀ」シートから、列Aの2行目から最終行までのデータを配列
stに読み込みます。ReDim Preserveステートメントを使用して、動的配列の要素数を1つずつ増やしながら、配列stに値を格納しています。 - 次に、アクティブなシートである現在のシートに対して、マッチング結果を表示するための列を挿入します。
Columns(2).Insertステートメントを使用して、列Bに新しい列を挿入しています。 For tate = 0 To UBound(st)で、配列st内の各要素に対して、アクティブなシートの列Aの各セルを検索します。検索は、For Each rH In Range("A2:A" & LastRow2)で実行され、rH.Value = st(tate)で条件に一致するセルを見つけます。条件が一致する場合、rH.Offset(, 1).Value = "OK"で、該当するセルの隣の列（列B）に”OK”という文字列を表示します。- 最後に、計算モードを自動に戻して、スクリーンアップデートを有効にします。そして、
MsgBox "完了"で処理が完了したことを示します。 - このマクロは、動的配列を使用して、検索対象のデータをメモリに一度に読み込み、一致する値が見つかった場合にそれを表示する方法を示しています
改善点
このコードの改善点としては、以下の点が挙げられます。
- 変数の命名 このコードでは、変数名が分かりにくいため、コードの可読性が低いです。たとえば、”tate”や”rH”といった変数名は、何を表しているかわかりにくいです。より分かりやすい変数名に変更することで、コードの可読性を向上させることができます。
- セルの範囲指定 このコードでは、Rangeメソッドを使用して、セルの範囲を指定しています。しかし、Rangeメソッドは遅いため、使用する回数を減らすことで、コードの実行速度を向上させることが可能です。
上記を高速化するエクセルマクロ
スピードを上げるためには、Rangeメソッドを使用する回数を減らすように改善
Sub 動的配列でマッチング_高速化()
Dim tate As Long
Dim st() As String
Dim rng As Range, rH As Range
Application.ScreenUpdating = False
Application.Calculation = xlManual
' 検索データを配列に読み込む
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("検索ﾃﾞｰﾀ")
st = ws1.Range("A2:A" & ws1.Cells(Rows.Count, 1).End(xlUp).Row).Value
' アクティブシート
Dim ws2 As Worksheet
Set ws2 = ActiveSheet
Dim LastRow2 As Long
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws2.Range("A2:A" & LastRow2)
Columns(2).Insert
' マッチング
For tate = 1 To UBound(st)
Set rH = rng.Find(st(tate, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not rH Is Nothing Then
ws2.Cells(rH.Row, rH.Column + 1).Value = "OK"
End If
Next tate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "完了"
Application.ScreenUpdating = False
Application.Calculation = xlManual
' 検索データを配列に読み込む
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("検索ﾃﾞｰﾀ")
st = ws1.Range("A2:A" & ws1.Cells(Rows.Count, 1).End(xlUp).Row).Value
' アクティブシート
Dim ws2 As Worksheet
Set ws2 = ActiveSheet
Dim LastRow2 As Long
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws2.Range("A2:A" & LastRow2)
Columns(2).Insert
' マッチング
For tate = 1 To UBound(st)
Set rH = rng.Find(st(tate, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not rH Is Nothing Then
ws2.Cells(rH.Row, rH.Column + 1).Value = "OK"
End If
Next tate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "完了"
End Sub解説
これは検索データを一度に配列に読み込み、アクティブシートのRangeオブジェクトを一度だけ設定しています。さらに、ループ内のRange.Findメソッドで検索を行っています。これにより、マクロの処理速度が大幅に向上します。
- 検索データを配列に読み込む
- Rangeメソッドを使用すると、セルを個別に読み込むため、処理が遅くなります。代わりに、配列に検索データを一度に読み込むことができます。これにより、処理速度が大幅に向上します。
- Rangeオブジェクトを一度だけ設定する
- Rangeメソッドを使用すると、Rangeオブジェクトを一度だけ設定するためにループを使用する必要があります。これは、処理時間を増やす原因となります。その代わりに、Rangeオブジェクトを一度だけ設定することで、処理速度を向上させることができます。
コメント