再質問です。マクロの修正箇所を教えてください。

データの過不足を確認するマクロを作成してみました。（毎年使うので、フィルタや関数ではなくマクロを作っておきたい）
１０行×３０列で動作確認したんですが、１００００行×A～JQ列までの大量データでは時間がかかってしまい強制終了、一度も作業が完了していません。
ちなみに１行目にはスペースの列もあり、同列の作業を行わないようにするやりかたも教えていただければ…

Sub 過不足チェック()
'定義
Dim ws As Worksheet
Dim cell As Range
Dim lastRow As Integer
Dim lastCol As Integer
' シート名は適宜変更
Set ws = ThisWorkbook.Sheets("Sheet1")
' 塗りつぶしのクリア
ws.Cells.Interior.ColorIndex = xlNone
' 範囲指定（最終行、列まで）
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row '1列目の最終行をカウント
lastCol = ws.Cells(2, Columns.Count).End(xlToLeft).Column '2行目の最終列をカウント
For Each cell In ws.Range(Cells(3, 3), Cells(lastRow, rng))

'未検査項目チェック（必須項目漏れに黄色を設定）
' A列（年齢）<30　かつ　1行目（年代別検査項目）=20　または
' A列（年齢）>=30 <40　かつ　1行目（年代別検査項目）<=30　または
' A列（年齢）>=40 <50　かつ　1行目（年代別検査項目）<=40　または
' A列（年齢）>=50　かつ　1行目（年代別検査項目）<=50　または
' B列（性別）女　かつ　A列（年齢）偶数　かつ　1行目（年代別検査項目）=1（子宮がん）　または
' B列（性別）女　かつ　A列（年齢）>=40　＆　偶数　かつ　1行目（年代別検査項目）=2（マンモ） のセルが
'空白以外なら…
If (ws.Cells(cell.Row, "A").Value < 30 And ws.Cells(1, cell.Column).Value = 20) Or _
(ws.Cells(cell.Row, "A").Value >= 30 And ws.Cells(cell.Row, "A").Value < 40 And ws.Cells(1, cell.Column).Value <= 30) Or _
(ws.Cells(cell.Row, "A").Value >= 40 And ws.Cells(cell.Row, "A").Value < 50 And ws.Cells(1, cell.Column).Value <= 40) Or _
(ws.Cells(cell.Row, "A").Value >= 50 And ws.Cells(1, cell.Column).Value <= 50) Or _
(ws.Cells(cell.Row, "B").Value = "女" And ws.Cells(cell.Row, "A").Value Mod 2 = 0 And ws.Cells(1, cell.Column).Value = "子宮がん") Or _
(ws.Cells(cell.Row, "B").Value = "女" And (ws.Cells(cell.Row, "A").Value >= 40 Or ws.Cells(cell.Row, "A").Value Mod 2 = 0) And ws.Cells(1, cell.Column).Value = "乳がん") Then
If cell.Value = "" Then
' 黄色を設定
cell.Interior.ColorIndex = 36
End If
End If

'追加項目チェック（必須項目以外＋データありにピンクを設定）
' A列（年齢）<30　かつ　1行目（年代別検査項目）>=30　または
' A列（年齢）>=30 <40　かつ　1行目（年代別検査項目）>=40　または
' A列（年齢）>=40 <50　かつ　1行目（年代別検査項目）=50　または
' B列（性別）女　かつ　A列（年齢）奇数　かつ　1行目（年代別検査項目）子宮がん　または
' B列（性別）女　かつ　A列（年齢）<40　or　奇数　かつ　1行目（年代別検査項目）乳がん のセルが
'空白以外なら…
If (ws.Cells(cell.Row, "A").Value < 30 And ws.Cells(1, cell.Column).Value >= 30 And ws.Cells(1, cell.Column).Value <= 50) Or _
(ws.Cells(cell.Row, "A").Value >= 30 And ws.Cells(cell.Row, "A").Value < 40 And ws.Cells(1, cell.Column).Value >= 40 And ws.Cells(1, cell.Column).Value <= 50) Or _
(ws.Cells(cell.Row, "A").Value >= 40 And ws.Cells(cell.Row, "A").Value < 50 And ws.Cells(1, cell.Column).Value = 50) Or _
(ws.Cells(cell.Row, "B").Value = "女" And ws.Cells(cell.Row, "A").Value Mod 2 = 1 And ws.Cells(1, cell.Column).Value = "子宮がん") Or _
(ws.Cells(cell.Row, "B").Value = "女" And (ws.Cells(cell.Row, "A").Value < 40 Or ws.Cells(cell.Row, "A").Value Mod 2 = 1) And ws.Cells(1, cell.Column).Value = "乳がん") Then
If cell.Value <> "" Then
' ピンクを設定
cell.Interior.ColorIndex = 22
End If
End If

Next cell
End Sub

No.2 回答者： fujillin 回答日時： 2024/07/18 16:57

No1です。

連投すみません。判定方法に関して書き忘れましたので。


データの範囲や取りうる値の可能性が不明なので、ご提示に無い値などをどう扱うかがわかりませんけれど・・

例えば、
前半の年代と年代別検査項目の関係のチェックで言えば、
　period = =MAX(MIN(INT(年齢/10),5),2)*10
を計算すると、20～50代はその年代が、10代以下は20、60代以上は50の値が返ります。
このような判断でも良いのなら、
　年代別検査項目 <= period
のように1つの計算式で全部のデータを判定できるようになり、場合分けも不要になるので、計算量を大幅に減ずることができます。

上記はあくまでも例示ですが、判定内容を整理して、方法を工夫することでもコードを単純化でき、計算量を減らすことは可能そうに思われます。
（一般化した場合の概念がわかりやすいかどうかは、微妙ですけれど・・）

No.1 回答者： fujillin 回答日時： 2024/07/18 13:04

こんにちは

＞１０行×３０列で動作確認したんですが、～
ご提示のコードで、動作確認できるとは思えません。

＞For Each cell In ws.Range(Cells(3, 3), Cells(lastRow, rng))
の変数rngが未定義なので、範囲が定まらないはずです。


ついでながら・・
＞lastCol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
変数lastColはその後で使っていないようですが、検査項目用の値をカウントしているのなら、1行目の最終列を求めるべきなのでは？
（何をしたいのか不明なので、よくわかりませんが・・）
後のチェックで参照しているのは、1行目で2行目を参照しているものはなさそうですが・・？？

判定内容がかなり煩雑ですが、二つのブロックで同じ判断（＝年代分け）を繰り返しているので、先に「年代・性別」での分岐を行って、その上で各判断を行う方が効率的なように思われます。
また、年代判定を○○～◇◇のような方法で行っていますけれど・・
（毎回、全ての両端を判断している）
例えば、年齢の低い順なら
　If age < 30 Then
　　' 20代用の判定（まとめて判定）
　Else If age < 40 Then
　　' 30代用の判定（まとめて判定）
　Else If age < 50 Then
　　' 40代用の判定（まとめて判定）
　Else
　　' 50代用の判定（まとめて判定）
　End If
のようなロジックにすることで、視認性があがると共に判定の回数も大幅に減ずることが可能になります。
なお、ご提示の処理手順だと、同じ行の各セルに対して、何度も年代分けの判定を行っていることになりますが、1行単位のデータだと思いますので、行単位で処理する方法に変えれば、年代の判定は1回/1行で済ませることができます。