Changeイベントを使用して重複チェックをしたい

こんにちは。
添付のような表があるとして、
各列内のみでそれぞれ重複チェックができればと考えております。

通常の条件式が一般的かと思いますが、
添付を例にすると、9/1の山田を9/4～9/8に9/1のセルをそのままコピペしたりするのと、
自分だけではなく複数の人物が同表をいじるため、どんどん条件式がずれたりおかしくなるのを予防したく、
VBAでできればと今回の質問に至っております。

少し前に似たような質問をしてご回答をいただき、
それを参考に作成してみたのですが自分が考える動きをしなかったので、
改めての質問となります。

詳しい方ご教示いただけますと幸いです。
宜しくお願いいたします。

（当方：WIN10 Excel2019）

No.1 ベストアンサー 回答者： fujillin 回答日時： 2023/08/02 14:53

こんにちは

ご質問の内容を実現することは可能ですが、問題になりそうな点があります。
Changeイベントでセルの書式等を変更すると、Ctrl+Z(=Undo）が効かなくなります。

例えば、ユーザーがセル範囲をコピペする際に、間違った場所にペーストしてしまったとします。
ユーザーは「あっ、間違えちゃった」と思い、Ctr+Zを押しますが動作しません。
（間違って）ペーストした範囲の以前の値などは覚えていませんので、どうにもできませんし、Ctrl+Zが効かないことがフラストレーションの原因にもなりかねません。

「そんなのどうでもいい」と言うのであれば、以下の手順で処理を行えば可能と思います。
変更のあったセル範囲は引数Targetで得られますが、必ずしも1セルとは限りませんし、チェックなさりたい列範囲をまたいでいる可能性もありますので、注意が必要です。

どの範囲の変更をチェックするのか不明ですが、4列ずつのブロックになっているようですので、そのブロック毎に変更があるかを順にチェックし、変更があればその範囲については全部のセルの重複チェックが必要となると考えられます。
具体的には
　If Not Intersect(Target, チェックするブロック範囲) Is Nothing Then
　　’ ブロック内で変更があったので、重複チェックを行う
　End If
のような形式で、全ブロックを順にチェックしてゆけば良いでしょう。
（ブロックが20～34行なのか、4～34行なのかはよくわかりませんけれど・・）

あるブロック内での重複チェック処理に関しては
　1）ブロック内の表示をまとめて標準状態にする
　2）各セルについて順に重複をチェックし、重複があれば書式を設定
等とすることで可能と思います。

※ ご質問文からだけでは、ブロックの上半分と下半分での重複をチェックするのか、全体をまとめて重複をチェックするのか、複合的にチェックするのか不明ですので、具体的な記述にはできません。

重複チェックの具体的な手法としては、
　・普通に範囲内をループして重複をカウント
　・Dictionary等を作成してから、重複をチェック
　・Findメソッド等で重複をチェック
　・CountIf関数を利用して重複をチェック
等が考えられます。
記述として一番簡単なのは、CountIf関数を利用する方法でしょうか。

この回答へのお礼

ご回答ありがとうございます！
ブロックは4列ずつで、ブロックの上半分と下半分全部まとめてチェックができればと考えています。

画像例で言うと、列O～R迄、行は34迄を9/1分1ブロックとなり、次いで9/2の列、9/3の列…と各ブロック内で重複チェックを考えてました。

よろしければ参考までに具体的な記述を教えていただけると幸いです…


尚、コピペミスがあった際、元に戻すことができないとのご指摘でしたが、重複チェックもできて、元に戻す動きもできるとなると、やはり一般的な条件付き書式しかないでしょうか…

お礼日時：2023/08/02 16:25

No.2 回答者： fujillin 回答日時： 2023/08/02 22:35

No1です。

＞よろしければ参考までに具体的な記述を教えていただけると幸いです
No1の内容をそのまま記述すれば良いだけですが・・

サンプルなので、以下は1ブロック分のチェックの例です。
書式設定は表示色の変更のみとし、色は適当に設定してあります。
（平常時は黒と仮定）

※ 勝手な想像で17～19行は対象外と考えて、範囲から外してあります。
このため、1ブロックが2つのセル範囲になるため、Countifでは一発で集計はできません。ですので、2分割して計算しています。
（後は、No1に記載の通りです）
※ 複数ブロックを順に処理したい場合は、ループ等で繰り返すようにすれば良いでしょう。

以下、ご参考までに。
※ 書式変更だけのようですので、イベントの発生を中止してはいませんけれど、必要であればイベントの発生を中止して処理を行うようにしてください。
（その方が安全な処理になります。イベント中止 ⇒ EnableEvents=False ）

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range, c As Range
Const BlockArea = "O4:R16,O20:R34" ' チェックブロック範囲（2分割を想定）

Set rg = Range(BlockArea)
If Not Intersect(Target, rg) Is Nothing Then
　rg.Font.Color = vbBlack ' 通常書式に設定
　For Each c In rg
　　If Application.CountIf(rg.Areas(1), c.Value) + _
　　 Application.CountIf(rg.Areas(2), c.Value) > 1 Then _
　　　c.Font.Color = rgbDarkViolet ' 重複時の書式に設定
　Next c
End If
End Sub

この回答へのお礼

ありがとうございました！
解決しました！

お礼日時：2023/09/12 10:20