![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
データの過不足を確認するマクロを作成してみました。(毎年使うので、フィルタや関数ではなくマクロを作っておきたい)
10行×30列で動作確認したんですが、10000行×A~JQ列までの大量データでは時間がかかってしまい強制終了、一度も作業が完了していません。
ちなみに1行目にはスペースの列もあり、同列の作業を行わないようにするやりかたも教えていただければ…
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
![](http://oshiete.xgoo.jp/images/v2/common/profile/M/noimageicon_setting_08.png?e8efa67)
- 画像を添付する (ファイルサイズ:10MB以内、ファイル形式:JPG/GIF/PNG)
- 今の自分の気分スタンプを選ぼう!
A 回答 (3件)
- 最新から表示
- 回答順に表示
No.3
- 回答日時:
コードを読み切れていません、
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とか1とかを入れるようにしておき、全ての処理が終わった段階で、現実のデータシートとmyResultを比較して
データシートの色塗りをすればよいかと思います。
尚、空白の行、空白の列があると、CurrentRegionで、正しくエリアをもってこれませんので、注意願います。
判定基準がテーブルで与えられているなら、choose関数でテーブルを構成するという手もあるかと思います。
参考にして頂ければ幸いです。
No.2
- 回答日時:
No1です。
連投すみません。判定方法に関して書き忘れましたので。
データの範囲や取りうる値の可能性が不明なので、ご提示に無い値などをどう扱うかがわかりませんけれど・・
例えば、
前半の年代と年代別検査項目の関係のチェックで言えば、
period = =MAX(MIN(INT(年齢/10),5),2)*10
を計算すると、20~50代はその年代が、10代以下は20、60代以上は50の値が返ります。
このような判断でも良いのなら、
年代別検査項目 <= period
のように1つの計算式で全部のデータを判定できるようになり、場合分けも不要になるので、計算量を大幅に減ずることができます。
上記はあくまでも例示ですが、判定内容を整理して、方法を工夫することでもコードを単純化でき、計算量を減らすことは可能そうに思われます。
(一般化した場合の概念がわかりやすいかどうかは、微妙ですけれど・・)
No.1
- 回答日時:
こんにちは
>10行×30列で動作確認したんですが、~
ご提示のコードで、動作確認できるとは思えません。
>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行で済ませることができます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) B列に文字がはいったらA列に数字が入るマクロードを完成させたい 4 2023/04/21 01:58
- Visual Basic(VBA) VBAコードが作動しません。修正したいのですが何処に原因かあるか教えて下さい。 1 2024/01/08 16:23
- Excel(エクセル) エクセルマクロでデータ出力の際の条件がうまく機能しません。 5 2023/10/01 12:50
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) エクセルマクロで出力行の増やし方がわかりません。 4 2023/09/28 23:40
- Excel(エクセル) エクセルマクロでデータ出力の際の条件がうまく機能しません。 2 2023/09/30 13:01
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 今日の日付が過ぎたらその行を削除したい 1 2023/04/01 20:06
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
- Visual Basic(VBA) VBA listBoxについて 2 2024/03/26 16:14
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
再質問です。マクロの修正箇所...
-
VLOOKUPの列番号の最大は?
-
LEFT関数とIF関数の組み合わせ...
-
「段」と「行」の違いがよくわ...
-
エクセルで最初の行や列を開け...
-
CSVファイルの「0落ち」にVBA
-
エクセルで離れた列を選択して...
-
リストからデータを紐付けしたい
-
エクセルで複数列の検索をマク...
-
エクセルマクロの組み方
-
Excel文字列一括変換
-
列方向、行方向の定義
-
データシートビューのタイトル...
-
Excel 区切り位置指定ウィザー...
-
Excel 2007で複合グラフ(折線...
-
Excelの行数、列数を増やしたい...
-
セルの値が指定条件なら対象行...
-
エクセルマクロで表の途中の集...
-
Accessのレポートで繰り返し表...
-
列を1つずつ非表示にしたい
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで離れた列を選択して...
-
「段」と「行」の違いがよくわ...
-
VLOOKUPの列番号の最大は?
-
LEFT関数とIF関数の組み合わせ...
-
VBA 指定した列にある日時デー...
-
Alt+Shift+↑を一括で行うには、...
-
エクセルで住所を県と市・郡と...
-
エクセルで複数列の検索をマク...
-
Excelの行数、列数を増やしたい...
-
VBAで結合セルを転記する法を教...
-
エクセルマクロPrivate Subを複...
-
エクセルマクロの組み方
-
CSVファイルの「0落ち」にVBA
-
列方向、行方向の定義
-
リストからデータを紐付けしたい
-
エクセルのソートで、数字より...
-
Excel文字列一括変換
-
エクセルで最初の行や列を開け...
-
エクセルでセル12個間隔で合...
-
エクセル マクロ 範囲指定で...
おすすめ情報