配列を使用し高速化
高速化するためには、セルへのアクセスを減らすことが肝要です。そのためには、セルを一気に配列に代入し、配列を使用し、処理後も別な配列に入れ、最後に、その配列をセルに書き込むことで、圧倒的な高速化が図れます。
以下が、処理するシートです。このようなデータが、544行目まで、入力されています。
この表の右側に、以下のように黄色の検索窓と見出しを入力し、検索窓に入れたキーワードが産業分類の一部と一致しているデータを見出しの下に抽出するというものです。
以下が、マクロを実行した結果です。検索窓に、「パン」と入力し、検索ボタンを押すと、産業分類にパンが含まれるデータが抽出されます。
以下がマクロの全体です。このマクロは、シートモジュールに入力しています。シートモジュールについては、以下を参照してください。
https://blogvba.com/sheetmodule/
Option Explicit
' モジュールレベル変数
Private Value() As Variant ' 表の値を、一気に、この配列に入れる
Private Tbl() As Variant ' 検索結果を入れる配列
Private num As Long ' 配列の行
' 以下がメイン処理で、ボタンにこのマクロを登録している
Sub 検索()
Call 変数に値を一気に代入
Call 検索結果を表に入れる
Call 表をセルに入れる
End Sub
Sub 変数に値を一気に代入()
Dim Rng As Range
'表の見出しを除くデータ範囲を取得する
With Range("B9").CurrentRegion
' 最初の5行が見出しと合計行なので、除外する
Set Rng = .Resize(.Rows.Count - 5).Offset(5)
End With
' Variant型の変数に、大きな表の値を一気に代入する
Value = Rng.Value
End Sub
Sub 検索結果を表に入れる()
Dim i As Long, j As Long
Dim cnt As Long
' 検索結果の表を作る
' Valueの配列を最初から最後まで繰り返し
For i = LBound(Value) To UBound(Value)
' 「産業分野」に検索文字が含まれる場合
If InStr(Value(i, 4), Range("検索文字")) > 0 Then
cnt = cnt + 1 ' 検索結果の表の行数
' 動的配列の設定、要素に代入済みデータはクリアせず、サイズを変更
ReDim Preserve Tbl(1 To 9, 1 To cnt)
' 検索結果の表の1行目は、4列目の「産業分野」を入れる
Tbl(1, cnt) = Value(i, 4)
' 検索結果の表の2-9行目は、6-13列目のデータを入れる
For j = 2 To 9
Tbl(j, cnt) = Value(i, j + 4)
Next j
End If
Next
num = cnt ' モジュールレベル変数に代入
End Sub
Sub 表をセルに入れる()
' 検索結果の表示させる場所をクリア
Dim r As Long
r = Cells(Rows.Count, "S").End(xlUp).Row ' S列最後の行
' 計算結果が空欄の場合、rに5が入り、見出しが消えるので、それを防ぐ
If r >= 9 Then
Range(Cells(9, "S"), Cells(r, "AA")).ClearContents
End If
' 計算結果が空欄だと、エラーが出るので、それを防ぐ
If num > 0 Then
' 動的配列で要素数を変更できるのは最終次元だけなので
' Transpose で配列の行列を入替える
Range("S9").Resize(num, 9).Value = Application.WorksheetFunction.Transpose(Tbl)
Else
MsgBox "検索結果はありませんでした"
End If
End Subそれでは、少しずつ解説しています。
Option Explicit
' モジュールレベル変数
Private Value() As Variant ' 表の値を、一気に、この配列に入れる
Private Tbl() As Variant ' 検索結果を入れる配列
Private num As Long ' 配列の行プロシージャを分割しているため、プロシージャ間で共通して使用する変数は、モジュールレベル変数で定義しています。
' 以下がメイン処理で、ボタンにこのマクロを登録している
Sub 検索()
Call 変数に値を一気に代入
Call 検索結果を表に入れる
Call 表をセルに入れる
End Subこのプロシージャが、メインの処理で、3つのプロシージャに分けて、処理しています。
Sub 変数に値を一気に代入()
Dim Rng As Range
'表の見出しを除くデータ範囲を取得する
With Range("B9").CurrentRegion
' 最初の5行が見出しと合計行なので、除外する
Set Rng = .Resize(.Rows.Count - 5).Offset(5)
End With
' Variant型の変数に、大きな表の値を一気に代入する
Value = Rng.Value
End Subここが、セルを一気に配列に入れる処理です。Rangeオブジェクトを使用して、必要な範囲を選んで、一気に、Variant変数に入れています。汎用的に使用できる例になっています。
Sub 検索結果を表に入れる()
Dim i As Long, j As Long
Dim cnt As Long
' 検索結果の表を作る
' Valueの配列を最初から最後まで繰り返し
For i = LBound(Value) To UBound(Value)
' 「産業分野」に検索文字が含まれる場合
If InStr(Value(i, 4), Range("検索文字")) > 0 Then
cnt = cnt + 1 ' 検索結果の表の行数
' 動的配列の設定、要素に代入済みデータはクリアせず、サイズを変更
ReDim Preserve Tbl(1 To 9, 1 To cnt)
' 検索結果の表の1行目は、4列目の「産業分野」を入れる
Tbl(1, cnt) = Value(i, 4)
' 検索結果の表の2-9行目は、6-13列目のデータを入れる
For j = 2 To 9
Tbl(j, cnt) = Value(i, j + 4)
Next j
End If
Next
num = cnt ' モジュールレベル変数に代入
End Sub「Value」配列から、抽出条件により、新しい表「Tbl」配列を作成しています。「Tbl」配列は、二次元配列で、一次元目は「Value」配列でいうところの列に当たり、二次元目は行に当たります。抽出データが増えるごとに、二次元目を増加させながら、配列を大きくしています。動的配列で要素数を変更できるのは最終次元だけなので、このような処理になっています。
Sub 表をセルに入れる()
' 検索結果の表示させる場所をクリア
Dim r As Long
r = Cells(Rows.Count, "S").End(xlUp).Row ' S列最後の行
' 計算結果が空欄の場合、rに5が入り、見出しが消えるので、それを防ぐ
If r >= 9 Then
Range(Cells(9, "S"), Cells(r, "AA")).ClearContents
End If
' 計算結果が空欄だと、エラーが出るので、それを防ぐ
If num > 0 Then
' 動的配列で要素数を変更できるのは最終次元だけなので
' Transpose で配列の行列を入替える
Range("S9").Resize(num, 9).Value = Application.WorksheetFunction.Transpose(Tbl)
Else
MsgBox "検索結果はありませんでした"
End If
End Subこれが最後の処理です。
値のクリアは、単純に最終行まで、クリアすると、データがない状態が2度続くと、見出しが消えるので、最終行が、9以上の場合、クリアするようにしています。
「Tbl」配列を、セルに入れるときは、行列を入れ替える必要があるので、「Transpose」を使用しています。
いかがでしょうか。セルを配列に入れ、そこから新しい配列を作り、その配列をセルに入れるマクロです。高速化を図りたいときは、参考になりますので、ぜひ、利用してください。
使用したファイルは、以下からダウンロードしてください。
Follow me!
