データチェックを行うエクセルマクロをおしえてほしい

1万件以上の健康診断結果Excelデータあり（1人1行、A～JQ列まであり）
別途、1行目に年代別（20.30.40.50代）区分（重複あり）を追加し、A列の年齢及びB列の性別を組み合わせてデータチェックを行いたい。（過不足の有無）
・必須項目チェックを行い、スペースであれば網掛けを行う。
・網掛けをした行のみ別シートにコピペする。

いろいろ試してみたが、1行目に空白の列があることやデータ量が多くマクロの実行に時間がかかってしまったので、効率の良いコードがあれば教えてほしい。

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

• 毎年同じ作業をするので、マクロにチャレンジしたいと思っています。
  参考までに自分が作成してみたマクロを貼っていますのでアドバイスをいただければ…
  
  １０行×５０列でマクロを作成し動作確認したうえで、本データにて実行してみましたが、”1行目がスペースまで作業をしている？”のか時間がかかり強制終了し、一度も作業が完了していません。
  
  Sub 過不足チェック()
  '定義
  Dim ws As Worksheet
  Dim cell As Range
  Dim lastRow As Integer
  Dim lastCol As Integer
  ' シート名は適宜変更
  Set ws = ThisWorkbook.Sheets("Sheet1")
  
  つづく

    補足日時：2024/07/18 08:48

• ' 範囲指定（最終行、列まで）
  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　のセルが
  '空白以外なら…
  
  つづく

    補足日時：2024/07/18 09:00

No.3 ベストアンサー 回答者： fujillin 回答日時： 2024/07/17 15:42

こんにちは

＞マクロの実行に時間がかかってしまったので、
＞効率の良いコードがあれば教えてほしい。
No1様の回答に1票です。
マクロは所詮マクロなので、エクセルの内部計算の方が速いです。


どうしてもマクロで処理したくて、かつ速度を向上したいのであれば・・
検索すれば、画面更新を止めるなどの方法がすぐに見つかると思います。
上記でもそれなりの効果はありますが、マクロで時間がかかるのはシートへのアクセス（＝読み・書き）です。
これを減らすロジックにすれば、速度は向上します。

現状がどのような計算を行っているのか不明ですけれど・・
もしも、1セルずつ処理するような方法を取っているのなら、セル範囲でまとめて処理する方法にすることで格段に速度は向上します。
ひとつの例として、データをまとめて読んで、メモリ内で計算し、結果をまとめて返す（＝記入する）などが考えられます。
ただし、メモリを必要としますので、データ量が多いような場合には、ある程度に区切って処理するなどの工夫が必要かも知れません。

No.6 回答者： もちからぼたもち 回答日時： 2024/07/18 11:33

フィルタして色付けして別シートにコピーをマクロ記録してそこからプログラミングスタートする感じと思います。

No.5 回答者： もちからぼたもち 回答日時： 2024/07/18 07:25

たぶんフィルタだけでできそう。

この回答へのお礼

再質問しましたので見ていただければ…

お礼日時：2024/07/18 11:14

No.4 回答者： satoumasaru 回答日時： 2024/07/17 16:40

マクロでやっておられるのでしたらそのソースを貼り付けて聞かれる方がよいですよ。

No.2 回答者： デベロッパ一 回答日時： 2024/07/17 15:08

Sub CheckAndCopyData()

Dim wsData As Worksheet
Dim wsFiltered As Worksheet
Dim lastRow As Long
Dim i As Long
Dim age As String
Dim gender As String
Dim ageGroup As String
Dim ageColumn As Range
Dim genderColumn As Range
Dim ageGroupColumn As Range
Dim targetRow As Long

' シートの設定
Set wsData = ThisWorkbook.Sheets("Sheet1") ' データがあるシート名を適宜変更
Set wsFiltered = ThisWorkbook.Sheets.Add ' 結果をコピーするシートを新規作成

' ヘッダー行から必要な列のインデックスを取得
Set ageColumn = wsData.Rows(1).Find("年齢", LookIn:=xlValues, LookAt:=xlWhole)
Set genderColumn = wsData.Rows(1).Find("性別", LookIn:=xlValues, LookAt:=xlWhole)
Set ageGroupColumn = wsData.Rows(1).Find("年代別区分", LookIn:=xlValues, LookAt:=xlWhole)

If ageColumn Is Nothing Or genderColumn Is Nothing Or ageGroupColumn Is Nothing Then
MsgBox "必要な列が見つかりません。", vbExclamation
Exit Sub
End If

' 最終行を取得
lastRow = wsData.Cells(wsData.Rows.Count, ageColumn.Column).End(xlUp).Row

' データのチェックとコピー
targetRow = 1 ' コピー先シートの最初の行

For i = 2 To lastRow ' 2から始める（1行目はヘッダー）
age = Trim(wsData.Cells(i, ageColumn.Column).Value)
gender = Trim(wsData.Cells(i, genderColumn.Column).Value)
ageGroup = Trim(wsData.Cells(i, ageGroupColumn.Column).Value)

' 必須項目のチェック
If age = "" Or gender = "" Or ageGroup = "" Then
' 必須項目が空白の場合は網掛けしてコピー
wsData.Rows(i).Interior.Color = RGB(255, 255, 0) ' 黄色で網掛け
' データをコピー
wsData.Rows(i).Copy wsFiltered.Rows(targetRow)
targetRow = targetRow + 1
End If
Next i

' 結果シートの整形
wsFiltered.Columns.AutoFit

' メッセージボックスで終了を通知
MsgBox "処理が完了しました。", vbInformation
End Sub

No.1 回答者： angkor_h 回答日時： 2024/07/17 14:30

関数で処理できるような内容だと思います。

> ・…、スペースであれば網掛けを行う。
> ・網掛けをした行のみ別シートにコピペする。
この場合は、単に、
スペースがあれば、その行全体を抽出する、
でよいはず。