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

データの過不足を確認するマクロを作成してみました。（毎年使うので、フィルタや関数ではなくマクロを作っておきたい）
１０行×３０列で動作確認したんですが、１００００行×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

質問者からの補足コメント

• 回答ありがとうございます。
  1.Rng→lastcolの誤りです。（コピペ誤りです）
  2.1行目の設定で問題ありません。
  3.①～③のとおりです。
  チェックしたい項目が50項目（列）以上あり、列を指定すると次年度以降、変更する場合マクロを変更するのも大変なので、20～50の別の区分を設けて列毎にチェックしてはどうかと考えた次第です。
  4.年齢には空白はありません。
  
  最終的には不足データ、余分データのある個人（網掛けがある行データ）を別シートに出力したいと思っています。参考までに網掛け以外にもいい方法があれば教えていただければ…

  No.4の回答に寄せられた補足コメントです。 補足日時：2024/07/19 11:22

• 

  回答ありがとうございます。
  ・Rng→lastcolの誤りです。（コピペ誤りです）
  ・1行目の設定で問題ありません。
  ・回答いただいたif、elseifもチャレンジしましたが断念しまして…「20代用の判定」に該当するいいコードはありますか？
  （補足）
  ・チェックしたい項目が50項目（列）以上あり、列を指定すると次年度以降、項目が変更した場合マクロのコードを変更するのも大変なので、別途、1行目に20～50と別の区分を追加して列毎にチェックしてはどうかと考えた次第です。（マクロは変更必要なし）
  （例）A列が20代…1行目の値が20の列の値がスペースであれば網掛け（不足）、1行目の値が30～の列の値があれば網掛け（余分）を判定し、最終的にはそれぞれのリストを作成したいと考えています。

  No.1の回答に寄せられた補足コメントです。 補足日時：2024/07/19 11:40

No.7 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/07/20 10:07

No6です。

乳がん検診の判定方法に誤りがありましたので、訂正します。（仕様の勘違いです）
変更前の仕様
セルが空白の場合
　　年齢が40以上でかつ偶数で女の場合、検査項目が乳がんなら、網掛けする。
セルが空白でない場合
　　年齢が40未満でかつ奇数で女の場合、検査項目が乳がんなら、網掛けする。

変更後の仕様
セルが空白の場合
　　年齢が偶数で女の場合、検査項目が乳がんなら、網掛けする。
　　又は、年齢が40以上で女の場合、検査項目が乳がんなら、網掛けする。
セルが空白でない場合
年齢が奇数で女の場合、検査項目が乳がんなら、網掛けする。
　　又は、年齢が40未満で女の場合、検査項目が乳がんなら、網掛けする。


上記の変更のため、以下のように変換値1,3,4の設定方法を変えています。
①1行目の年代別検査項目は、事前に以下の値に変換しておき、変換後の値を参照することにより高速化を行う。
空白→""
20　　　→1
30　　　→2
40　　　→3
50　　　→4
子宮がん→16
乳がん　→32
上記以外はエラー終了する。変換後の値は変換値１へ格納しておく。

③セルが空白の場合のがん検診用の年齢及び性別は以下の形に変換する。
年齢が偶数かつ女の場合→16+32
年齢が40以上でかつ女の場合→32をorする。
上記以外　　　　　　　　　　　→0
変換後の値は変換値3へ格納しておく。

③セルが空白でない場合のがん検診用の年齢及び性別は以下の形に変換する。
年齢が奇数かつ女の場合→16+32
年齢が40未満でかつ女の場合→32をorする。
上記以外　　　　　　　　　　　→0
変換後の値は変換値4へ格納しておく。

④セルが空白の場合の判定方法
変換値1が16未満の場合
　　変換値2<変換値1であること
変換値1が16以上の場合
　　変換値3 and 変換値1の結果が0より大きいこと
上記条件が成立時、セルに黄の網掛けをする。

⑤セルが空白でない場合の判定方法
変換値1が16未満の場合
　　変換値2<変換値1であること
変換値1が16以上の場合
　　変換値4 and 変換値1の結果が0より大きいこと
上記条件が成立時、セルにピンクの網掛けをする。


修正後のソースのURLは下記参照
https://ideone.com/QbnFSF

この回答へのお礼

大変な分量をありがとうございました。
動作確認はこれからですが、取り急ぎお礼まで。

お礼日時：2024/07/22 10:47

No.6 回答者： tatsumaru77 回答日時： 2024/07/19 21:36

No5です。

一部誤りがありました。
③セルが空白でない場合のがん検診用の年齢及び性別は以下の形に変換する。
40以上で年齢が奇数かつ女の場合→10
40未満で年齢が偶数かつ女の場合→11
上記以外　　　　　　　　　　　→0
変換後の値は変換値4へ格納しておく。

の箇所ですが、
40未満で年齢が偶数かつ女の場合→11
は
40未満で年齢が奇数かつ女の場合→11
　　　　　　　^^^
の誤りです。訂正します。（マクロは訂正不要です）

No.5 回答者： tatsumaru77 回答日時： 2024/07/19 19:31

No4です。

補足ありがとうございました。
以下の使用でマクロを作成してみました。
１．１列目の最終行を最終行とする。（従来通り）
２．１行目の最終列を最終列とする。（新仕様）
３．セルのチェック範囲は、３行,３列～最終行、最終列とする。（従来通り）

４．高速化のための改造部分

①1行目の年代別検査項目は、事前に以下の値に変換しておき、変換後の値を参照することにより高速化を行う。
空白→""
20　　　→1
30　　　→2
40　　　→3
50　　　→4
子宮がん→10
乳がん　→11
上記以外はエラー終了する。変換後の値は変換値１へ格納しておく。

②年齢は、事前に以下の形に変換する。
30未満　　　　　→1
30以上かつ40未満→2
40以上かつ50未満→3
50以上　　　　　→3
1～100以外の年齢はエラー終了する。変換後の値は変換値2へ格納しておく。

③セルが空白の場合のがん検診用の年齢及び性別は以下の形に変換する。
40未満で年齢が偶数かつ女の場合→10
40以上で年齢が偶数かつ女の場合→11
上記以外　　　　　　　　　　　→0
変換後の値は変換値3へ格納しておく。

③セルが空白でない場合のがん検診用の年齢及び性別は以下の形に変換する。
40以上で年齢が奇数かつ女の場合→10
40未満で年齢が偶数かつ女の場合→11
上記以外　　　　　　　　　　　→0
変換後の値は変換値4へ格納しておく。

④セルが空白の場合の判定方法
変換値1が10未満の場合
　　変換値2<変換値1であること
変換値1が10以上の場合
　　変換値3>=変換値1であること
上記条件が成立時、セルに黄の網掛けをする。

⑤セルが空白でない場合の判定方法
変換値1が10未満の場合
　　変換値2<変換値1であること
変換値1が10以上の場合
　　変換値4>=変換値1であること
上記条件が成立時、セルにピンクの網掛けをする。

５．網掛け時の転記
網掛けを行った行は、別シート(Sheet2)へ転記する。

６．処理時間について
1万行でJQ列までのデータで、約2分かかりました。
最初はまず、少ない行で、動作確認を行ってください。

ソースのURLは下記参照
https://ideone.com/skeYhn

No.4 回答者： tatsumaru77 回答日時： 2024/07/19 09:07

補足要求です。

１．Rngについて
For Each cell In ws.Range(Cells(3, 3), Cells(lastrow, Rng))とありますが、
Rngは未定義です。
For Each cell In ws.Range(Cells(3, 3), Cells(lastrow, lastcol))
が正しいと思いますがいかがでしょうか。

２．最終列の判定は、2行目の最終列を求めていますが、通常は1行目の最終列を求めるかと思います。
2行目にした理由がなにかあるのでしょうか。参考までに教えていただけると嬉しいです。

３．1行目の3列～最終列は、年代別検査項目が定義されますが、その内訳は以下の内容であってますか。
①空白
②数字の場合　20 30 40 50 の何れか
③文字の場合　子宮がん　乳がん　の何れか

特に、数字の場合、上記以外の数字が記入されることもありますか。
（例　10 19 21 29 31 51 60 等）

４．Ａ列の年齢欄ですが、年齢が空白の行も存在しますか。（データのない行）

No.3 回答者： atom_28 回答日時： 2024/07/18 20:13

コードを読み切れていません、

for eachでセルをひとつずつ持ってきて、その上で、それを含む行の"A"列の値で・・・
次に、その右にあるセルをチェックする時、同じ処理をしているような気がします。つまり、同じ処理を何度も何度も繰り返しているような気がします。

兎に角、処理スピードを上げるのであれば、.currentregionで全エリアを選択して,variant変数にいれて、メモリ上の配列とし、以降このメモリ上の配列に対して判定処理をすべきと思います。

dim myData as variatnt

myData=Sheets("Sheet1").cells(1,1).CurrentRegion
lastRow = ubound(myData,1)
lastCol = ubound(myData,2)
for i=2 to lastRow
for j=1 to lastCol
if ...

end if
next
next

判定結果は別のメモリ上の配列(サイズはmyDataと同じ、myResultとか名前を付けて)に0とか１とかを入れるようにしておき、全ての処理が終わった段階で、現実のデータシートとmyResultを比較して
データシートの色塗りをすればよいかと思います。

尚、空白の行、空白の列があると、CurrentRegionで、正しくエリアをもってこれませんので、注意願います。

判定基準がテーブルで与えられているなら、choose関数でテーブルを構成するという手もあるかと思います。

参考にして頂ければ幸いです。

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行で済ませることができます。