キー項目が複数個あるデータをループでチェックする際に処理速度が非常に遅いマクロがあった。
チェック対象
| キー項目１ | キー項目２ | 値 | チェック結果 |
| 0001 | A001 | 100,000 | |
| 0002 | A003 | 10,000 |
チェックリスト
| キー項目１ | キー項目２ | 値範囲開始 | 値範囲終了 |
| 0001 | A001 | 10,000 | 500,000 |
| 0002 | A003 | 100,000 | 500,000 |
チェック対象を１行読んで、その値でチェックリストを全件ループし、キー項目１とキー項目２が一致していればその値の範囲をチェックするような仕組みだった。
例）
For i = 1 To チェック対象MAX行
For j = 1 To チェックリストMAX行
If キー項目１(チェック対象） = キー項目１（チェックリスト） And キー項目２(チェック対象） = キー項目２（チェックリスト） Then
'チェック処理
End If
Next j
Next i
チェック対象とチェックリストが少なければ大した問題にはならなかったが、データ件数が増えてくると１回の処理が３０分かかったりするようになってしまった。まぁ当然だけども・・・。
とはいえ、ある程度稼働した後だったのであんまり手を入れるのが怖かったので下記の関数を作った。っていうか探してきた。
'---------------------------------------------------------
' 文字列・数字セルを検索
' シート名と列位置を指定し検索する。該当した行位置をカンマ区切りで返す。
' １件ずつループしながらIf関数で１行ずつ判定するより圧倒的に高速
' 複数条件は対応外なので、この関数で該当行を絞ったうえで、If関数で詳細なチェックをかけたほうが高速になる
' 利用例）GetSearchStringNumberCell("0001","A:A","データ")
' 戻り値例）4,15,20
'---------------------------------------------------------
Public Function GetSearchStringNumberCell(ByVal strValue As String, ByVal strColumnRange As String, ByVal strSheetName As String) As String
Dim rng As Range
Dim adr As String
Dim strResult As String
GetSearchStringNumberCell = ""
Set rng = Sheets(strSheetName).Columns(strColumnRange).Find(strValue)
If rng Is Nothing Then
Exit Function
Else
adr = rng.Address
strResult = rng.Row
End If
Do
Set rng = Sheets(strSheetName).Columns(strColumnRange).FindNext(After:=rng)
If rng.Address = adr Then
Exit Do
Else
strResult = strResult & "," & rng.Row
End If
Loop
GetSearchStringNumberCell = strResult
End Function
Excelの標準機能を使うと処理速度が速くなるのは有名な話なので、検索する処理をExcelのFind関数に任せてみた。
Find関数は１項目しか検索できないので、１回で処理しようとすると複数項目を検索しようとすると検索用のキー項目を作る必要がある。
例）キー項目１＋キー項目２の値を横の列に作成して検索。（0001A002）
でも、すでに稼働しているところに手を入れるのは怖いので、この関数をここに入れてみた。
例）
For i = 1 To チェック対象MAX行
Dim strValue As String
Dim strArr() As String
strValue = GetSearchStringNumberCell(キー項目１(チェック対象）,"A:A","チェック対象
")
strArr = Split(strValue,",")
For jj = 0 To Ubound(strArr)
j = strArr(jj)
If キー項目１(チェック対象） = キー項目１（チェックリスト） And キー項目２(チェック対象） = キー項目２（チェックリスト） Then
'チェック処理
End If
Next j
Next i
GetSearchStringNumberCell関数は検索値、検索範囲（列など）、検索シートを指定し、実行することで検索値が含まれているセルの行位置をカンマ区切りで返してくれる。
そのため、戻り値をカンマでSplitすることで、チェックする必要のある行位置のみをループすればよいことになる。
この処理のおかげで処理速度が３０分が３０秒以下で終わるようになった。やっぱりExcel関数をなるべく使うほうがいいんだけど、使い方に慣れた関数でないとループやIf関数で処理をしたくなる。
あとは２次元配列にしたりすれば貼り付けの速度もかなり早くなるんだろうけど、そこまで改修しなくても問題ない速度になったのでここまでにしておこうと思う。
業務上支障のない速度になっていれば問題ないし、変に手を入れて、３０秒が１０秒になる程度であればコーヒーでも飲んでてもらえればいいし。
ちなみに日付セルを検索する場合はこっち
'---------------------------------------------------------
' 日付セルを検索
' シート名と列位置を指定し検索する。該当した行位置をカンマ区切りで返す。
' １件ずつループしながらIf関数で１行ずつ判定するより圧倒的に高速
' 複数条件は対応外なので、この関数で該当行を絞ったうえで、If関数で詳細なチェックをかけたほうが高速になる
' 利用例）GetSearchDateCell("2020/08/01","A:A","データ")
' 戻り値例）4,15,20
'---------------------------------------------------------
Public Function GetSearchDateCell(ByVal strValue As Date, ByVal strColumnRange As String, ByVal strSheetName As String) As String
Dim rng As Range
Dim adr As String
Dim strResult As String
GetSearchDateCell = ""
Set rng = Sheets(strSheetName).Columns(strColumnRange).Find(strValue)
If rng Is Nothing Then
Exit Function
Else
adr = rng.Address
strResult = rng.Row
End If
Do
Set rng = Sheets(strSheetName).Columns(strColumnRange).FindNext(After:=rng)
If rng.Address = adr Then
Exit Do
Else
strResult = strResult & "," & rng.Row
End If
Loop
GetSearchDateCell = strResult
End Function
引数が変わっただけ・・・。Object型とかVariant型にすれば統一できそうな気もする。
0 件のコメント:
コメントを投稿