[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『（マクロ）セル値比較と着色処理の高速化について』（マイン）
お世話になっております。
・下記コードは正常に動作しており
処理内容は
セルの値相違箇所に「太文字・文字色」を設定するコードとなります。
・課題となっているのは「処理速度」です。
行数が100を超えてくると、2-3秒程度かかり我慢できない範囲ではないのですが
下記コードで改善スべき点があればアドバイスの程よろしくおねがいします。
・具体的な流れは
（1）処理のセル範囲（基点の行列は固定）を求め
・7行目〜可変する最終行
・5列目〜可変する最終列
（2）2行単位で「上段と下段」セルを一つづつ比較し
（3）上下セルに相違があれば「文字の太さ・色」を変更
という流れになります。
※書式設定をあつかうため、シートの保護を「解除→再設定」というコードを組み入れています。
※マクロには「描画停止、自動計算停止」は組み入れています。
Sub 予定実績の相違チェック()
Dim sh1 As Worksheet: Set sh1 = ActiveSheet
'★最終行列の取得
With sh1
'最終列取得
Dim col As Long
On Error Resume Next '//←念のため
'AJ=4行目の36列目から左に検索（4行目には曜日番号がある）
For col = Cells(4, 36).End(xlToLeft).Column To 1 Step -1
'セルを順次左方向に値が""以外のセルに到達したら終了
If Cells(4, col) <> "" Then Exit For
Next col
'最終行取得
Dim row As Long
On Error Resume Next '//←念のため
For row = Cells(Rows.Count, "B").End(xlUp).row To 1 Step -1
If Cells(row, "B") <> "" Then Exit For
Next row
'★プロテクト解除
.Unprotect
'★セル比較と転記作業
Dim c, r As Long
For r = 7 To row Step 2 '2行単位毎に処理（比較本行=奇数）
For c = 5 To col '列
If Cells(r, c) <> Cells(r + 1, c) Then '上下セル値が相違の場合
With Cells(r + 1, c) '下セルに着色
.Font.Bold = True '太字
.Font.ColorIndex = 3 '赤
End With
End If
Next c
Next r
'★プロテクト実行
.Protect
End With
'MsgBox "着色完了"
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
手っ取り早く対象するなら、画面更新の抑制ですが、
http://www.wat3d.com/gogo/vba-speedup/1-ScreenUpdating-False/
根本から直すなら、該当セルを覚えておいて、最後に一括処理したほうがいいとおもいます。
あと、
On Error Resume Next '//←念のため
これは、逆にトラブルの原因になりかねないのでオススメしません。
（もこな２） 2019/01/28(月) 19:00
せっかくwith使ってるのに、Cellsの前に「.」が無いですよ。
sh1 = ActiveSheet なので結果として正しく動くでしょうが…
（もこな２） 2019/01/28(月) 19:05
＞※マクロには「描画停止、自動計算停止」は組み入れています。
失礼しました。画面抑制は既にされているのですね。
そうなると、根本から直すしかないようにおもいます。
テストしてないけどこんな感じにしてみてはどうでしょうか。
Sub 予定実績の相違チェック_改()
Dim 最終行 As Long, 最終列 As Long
Dim i As Long, r As Long, c As Long
Dim MyRNG As Range
With ActiveSheet
.Unprotect 'シート保護を解除
.Protect UserInterfaceOnly:=True 'シートを保護（マクロからの変更は許可）
'最終列を取得(AJ4から左に向かって最終セルを探し、さらにそこから左に値が""以外のセルを探す)
For i = .Range("AJ4").End(xlToLeft).Column To 1 Step -1
If .Cells(4, i) <> "" Then
最終列 = i
Exit For
End If
Next i
'最終行を取得（シートのB列最下セルから上に向かって最終セルを探し、さらにそこから上に値が""以外のセルを探す）
For i = .Cells(.Rows.Count, "B").End(xlUp).Row To 1 Step -1
If .Cells(i, "B") <> "" Then
最終行 = i
Exit For
End If
Next i
'条件判定
For r = 8 To 最終行 Step 2 '2行単位毎に処理（比較本行=奇数）
For c = 5 To 最終列 '列
With .Cells(r, c)
If .Value <> .Offset(-1).Value Then '【上】のセルと値を比較して不一致なら
If MyRNG Is Nothing Then
Set MyRNG = .Cells
Else
Set MyRNG = Union(MyRNG, .Cells)
End If
End If
End With
Next
Next
'処理判定 (該当セルがなければここで終了)
If MyRNG Is Nothing Then Exit Sub
'処理（ここで処理。↑はメモリ上の操作のため時間はかからないハズ）
With MyRNG.Font
.Bold = True '太字
.ColorIndex = 3 '赤
End With
End With
End Sub
（もこな２） 2019/01/28(月) 21:14
ありがとうございます。私も配列内で比較処理して書き出しというコード作成してみたのですが、
格納と比較までできましたが、一気に書き出しができず。スピード変わらず・・・・でした。
アドバイスコードを実行してみたところ。
爆速になりました。
元のコード（描画停止入り）よりも俊足でした。
もうすこし、いじらせて下さい。
（マイン） 2019/01/28(月) 21:37
>（2）2行単位で「上段と下段」セルを一つづつ比較し >（3）上下セルに相違があれば「文字の太さ・色」を変更 ご提示のコードは見てませんが、こう言う事はマクロより条件付き書式の方が向いてそうですね。 速さもインタプリタのマクロより数倍から数百倍は速いでしょうし。 （sy） 2019/01/29(火) 08:04
ありがとうございます。条件付き書式が予め多数セットされているのでどちらを優先させるか悩みどころでした。
そして、値相違チェックのみマクロに委ねた次第です。
条件付書式設定してある内容
・日付リスト読み込んで休日祝祭日に着色&罫線
・記号リストとセルに入力された値を比較しリストにない値が入力された時点で着色
・区分によって入力しないといけないセルが空欄の場合に警告着色
・区分によって入力してはいけないセルに値がある場合に警告着色
以上とあわせて数式もセットしているためシートがもっさりしています。
（マイン） 2019/01/29(火) 09:11
すいません。 （もこな２） 2019/01/28(月) 21:14 で速くなったと言う事なので、データ量MAXの時にも満足いく速さがあるなら問題ないと思います。
個人的にマクロにすると以下のような事で、メリットよりもデメリットの方が多い要件だなぁと思ったもので発言しました。 条件式も以下の簡単な式で出来るので、設定範囲を列全体とかにでもしない限り遅くなるとは思えなかったもので、 =AND(ISEVEN(ROW()),E6<>E7) 条件付き書式や数式で遅いなら、条件付き書式の設定範囲や数式の参照先を列全体など無駄に広い事が原因である事が多いです。 該当するなら一度範囲を想定できる最大範囲までに限定してみて下さい。 列全体からとかなら劇的に速くなると思います。
以下は個人の主観なので、デメリットを重視しなくて、現状の速さで満足レベルなら問題無いと思います。
マクロのメリット 数式での計算量が多すぎる時は値で処理できる分速くなる事がある。 適用範囲や計算対象範囲を最小限に限定できるので、最大範囲に入力しないと駄目な数式より速くなる事がある。
マクロのデメリット 基本数式や条件式よりは圧倒的に処理が遅い。(メリットのように速くなる時もある) アンドゥ機能のメモリ消えてしまう。(間違えた時などは非常に不便) 手動で設定した書式が消える。 マクロ有効ブックなので、マクロウィルス対策が必要になる。(xlsxなら必要無し)
>・記号リストとセルに入力された値を比較しリストにない値が入力された時点で着色 これに関しては入力規則のリスト選択にすれば、誤入力を防げるので、条件付き書式は必要無いですよ。
（sy） 2019/01/29(火) 21:55
コメントありがとうございます。
確かに、条件付き書式は瞬時に反応しますので、おっしゃる通りに条件付き書式で設定していました。
ただ、UserFormを用いて作成するにあたって仕様を以下のとおり見直しました。
（条件付き書式廃止）
・日付リスト読み込んで休日祝祭日に着色&罫線
→フォームから、月のSheet生成時に合わせてマクロ処理に組み込み（1度設定すれば良いので）
→一応、手動で月を変更することを想定して、日付セルにWorksheet_Changeで切り替え追加
※休日祝祭日に色を塗りたい場合、条件付き書式が優先されることもあるため
（条件付き書式に残した部分）
・記号リストとセルに入力された値を比較しリストにない値が入力された時点で着色
→ListBoxから記号を都度入力や一括入力処理するので間違いがないのですが
手入力するひともたまにいるので条件付き書式として設定
・区分によって入力しないといけないセルが空欄の場合に警告着色
・区分によって入力してはいけないセルに値がある場合に警告着色
土日祝日部分のコードはアドバイスいただいたUnionを使用して一括で処理するようにしました。
（月予定表）
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("J1")) Is Nothing Then
Exit Sub
Else
Call カレンダー作表
End If
End Sub
（カレンダー部分）
Sub カレンダー作表()
Dim sh1 As Worksheet: Set sh1 = ActiveSheet
With sh1
'★最終列取得
Dim col As Long 'カレンダーの最終列定数
'AJ=4行目の36列目から左に検索（4行目には曜日番号がある）
For col = .Cells(4, 36).End(xlToLeft).Column To 1 Step -1
'セルを順次左方向に値が""以外のセルに到達したら終了
If .Cells(4, col) <> "" Then Exit For
Next col
'★着色と罫線の初期化
With .Range("E5:AI66")
.Borders(xlInsideVertical).Weight = xlHairline '極細
.Interior.ColorIndex = 0 '無色
End With
'★作表
Dim MyColor As Range '公休の着色
Dim MyKei As Range '日曜右セルに罫線
Dim c As Long 'カレンダー行カウント用変数
For c = 5 To col '列5列目〜31列目まで処理 行固定（公休判断行は5行目）
'★日曜日を判定し罫線を設置
If Weekday(.Cells(5, c)) = vbSunday Then
If MyKei Is Nothing Then
Set MyKei = .Range(.Cells(5, c), Cells(66, c))
Else
Set MyKei = Application.Union(MyKei, .Range(.Cells(5, c), Cells(66, c)))
End If
End If
'★公休着色:土日祝日マスター参照数式から該当日付に「1」を表示させたものを判定
If .Cells(67, c) = 1 Then
If MyColor Is Nothing Then
Set MyColor = .Range(.Cells(5, c), Cells(66, c))
Else
Set MyColor = Application.Union(MyColor, .Range(.Cells(5, c), Cells(66, c)))
End If
End If
Next c
End With
'処理判定
If MyKei Is Nothing Then Exit Sub
With MyKei
.Borders(xlEdgeRight).Weight = xlThin '細
End With
If MyColor Is Nothing Then Exit Sub
With MyColor
.Interior.ColorIndex = 36 'うす黄色
End With
End Sub
（マイン） 2019/01/30(水) 07:55
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.