[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『重複があったらセルの色をつける(マクロ)』（みか）
重複が発生したらセルに色がつくようにしたい
A B C D E 1 日付 ID 住所 住所 名前 2 10001 ABCあいう 3 10002 TYUきき 4 10015 HYOらら 5 10001 ABCあいう 6 10020 KVRぽきき
条件：B2以降のデータが同じもので、E2以降を入力した時に重複があったらセルの色をつけて重複入力を気付くようにしたい。またセルの色は重複がなくなったら消えるようにしたい。データ範囲は2行目もしくは3、4行目以降になるかも知れません。また、データは今後7行目以降どんどん増えていきます。
入力時点で重複があることがすぐに分かるようにしたいのです。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
参考になると思います。
[[20111205161909]] 『重複登録させない』（ちょこ）
質問文はよく見てませんので外してたらすみません。 （カリーニン） 2015/07/12(日) 10:36
>>またセルの色は重複がなくなったら消えるようにしたい
この要件があるなら、なおさらのこと、条件付書式が適しています。
とはいえ、
>>マクロで実行したいのです。
マクロの勉強ということでしょうかね？ そうするとしたら、
>>重複入力を気付くようにしたい
ではなく、Ｂ列の重複入力そのものができないようにすべきでは？以下は色を付けず入力をはじきます。
シートモジュール（シートタブを右クリックしてコードの表示を選ぶ）に以下を貼り付け。
★ただし、Ｂ列入力時のみチェックします。他の列（たとえばＡ列）の入力はチェックしませんので そのあと、Ｂ列に重複入力を行った際には、はじかれて、Ｂ列の値が入力前に戻りますが、他の列は そのままです。実際の運用には問題がないかと思います。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Set r = Intersect(Target, Columns("B"))
If r Is Nothing Then Exit Sub
For Each c In r
If Not IsEmpty(c) And WorksheetFunction.CountIf(Columns("B"), c) > 1 Then
MsgBox c.Value & " はすでに入力済みです" & vbLf & "入力を取り消します"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
Next
End Sub
（β） 2015/07/12(日) 11:30
アップ後、ちょっと訂正。（18:52)
それでは
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Dim a As Range
Set r = Intersect(Target, Columns("B"))
If r Is Nothing Then Exit Sub
With Range("B2", Range("B" & Rows.Count).End(xlUp))
Columns("B").Interior.ColorIndex = xlNone
For Each c In .Cells
If WorksheetFunction.CountIf(.Cells, c) > 1 Then
If a Is Nothing Then
Set a = c
Else
Set a = Union(a, c)
End If
End If
Next
If Not a Is Nothing Then
a.Interior.ColorIndex = 6
End If
End With
End Sub
（β） 2015/07/12(日) 18:47
ありがとうございます。
マクロを実行してみてB列に色がつくので、自分の質問を見直しましたら、説明が抜けていました。すみません。
条件は、B列が重複していて、なおかつ、E列を入力した時に、E列に重複があった場合に、E列に色がつくようにしたいのです。
B列の同じIDの中で、E列を入力した時に名前が重複していたら、その時点で色がついて気付かせたいのです。（B列&E列が同じ場合、E列に色をつける、と言ったほうがいいんでしょうか）
B列はIDですが、同じIDが何度も出てきます。それはOKなのですが、E列に同じ名前が出てくるのはダメなので、それをチェックしたいんです。
説明が下手ですみません。。
（みか） 2015/07/12(日) 20:09
それでは、チェックする対象を B->E に、COUNTIF ではなく COUNTIFS に。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Dim a As Range
Set r = Intersect(Target, Columns("E"))
If r Is Nothing Then Exit Sub
With Range("E2", Range("E" & Rows.Count).End(xlUp))
Columns("E").Interior.ColorIndex = xlNone
For Each c In .Cells
If WorksheetFunction.CountIfs(.Cells, c, .Cells.Offset(, -3), c.Offset(, -3)) > 1 Then
If a Is Nothing Then
Set a = c
Else
Set a = Union(a, c)
End If
End If
Next
If Not a Is Nothing Then
a.Interior.ColorIndex = 6
End If
End With
End Sub
（β） 2015/07/12(日) 20:22
（みか） 2015/07/12(日) 21:05
βさん
会社で今作業しています。
すみません。上のサンプルは分かりやすく列位置は調整していました。
実際は下記の列番号になります。
B ⇒ F
E ⇒ M
A F C D M 1 日付 ID 住所 住所 名前 2 住所1 住所2 3 10001 ABCあいう 4 10002 TYUきき 5 10015 HYOらら 6 10001 ABCあいう 7 10020 KVRぽきき
頂いたマクロで、私の方でB列をF列に、E列をM列に変更すればいいかな、と安易に思っていたのですが、このマクロではB列をF列に変更できず。。
すみません。
どうすればいいでしょうか。
E を M というところは大丈夫だったと思います。（以前は２行目からだったので、それを３行目にしましたが） 難しかったのは B を F に変えるところですね。
COUNTIFS の中の .Cells.Offset(, -3), c.Offset(, -3) .Cells とか c は、以前は E 列でした。で、B列は、そこから 3列戻ったところなので OffSet で -3 。 今回は、基準が M 列で、チェックすべきは F 列ですね。F列は M列から 7列戻ったところですね。
コードは以下になります。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Dim a As Range
Set r = Intersect(Target, Columns("M")) '★
If r Is Nothing Then Exit Sub
With Range("M3", Range("M" & Rows.Count).End(xlUp)) '★
Columns("M").Interior.ColorIndex = xlNone '★
For Each c In .Cells
If WorksheetFunction.CountIfs(.Cells, c, .Cells.Offset(, -7), c.Offset(, -7)) > 1 Then '★とくにここ。
If a Is Nothing Then
Set a = c
Else
Set a = Union(a, c)
End If
End If
Next
If Not a Is Nothing Then
a.Interior.ColorIndex = 6
End If
End With
End Sub
（β） 2015/07/13(月) 09:55
いや、ちょっとも大変じゃないです。 というか、ちょっとずさんなコードでしたね。ごめんなさい。
Columns("M").Interior.ColorIndex = xlNone '★
これを
.Cells.Interior.ColorIndex = xlNone '★
に変更してください。
（β） 2015/07/13(月) 10:47
そして、本当に申し訳ないのですが、初めのリクエストで書いたように、重複がなくなったら付いた色が消える、っていうのは難しいですか？
現状は、重複があった場合、先に出現した方を先に消すと、後に出現した重複の色も先に出現した重複も両方の色が消えますが、反対に、後に出現した重複を先に消すと、先に出現した重複の方の色だけが消えて、後の重複の方の色が残ってしまいます。
本題ではないが。
返信時には「編集」ではなく下にあるコメント欄から行ってくれ。
それとも追加質問部分はみかさんではない？ (最初のお礼時にはきちんとコメント欄で行っているようだが） （ねむねむ） 2015/07/13(月) 13:12
回答の前に。 レスは、編集で付け足さず、下のコメント欄に書きこんでアップしましょう。 そうしないと、アップした時間やＨＮが表示されません。
で、回答。
えっ？そうですか？
こちらでは、たとえば、アップされたサンプルがあったとして、そこに 10001 ABCあいう を追加すると ３行に色がつきます。
で、そのあと、10002 TYUきき を追加すると、これら２行も色がついいて、都合、５行に色がついた状態ですね。
このあと、どちらの重複から退治しようが、重複がなくなったものは色がきえ、まだ重複が残っているものは 色がついたままです。
ただ、重複していないのに色が残るというのはありえるコードです。 たとえば追加した行で、上のほうの行と、追加した行のM列に色がついた。 で、ここで、追加した行のM列をクリアした。 上のほうの行のM列は重複がなくなるので色が消えるのですが、クリアした最後の行の色が残ったままです。 データが存在する行までの処理をしているので、クリアされたセルにはデータがなく、そこの色消し処理が まぁ、おそまつというか、手抜きコードだったんですが、そちらで色が残るというのは、そういう状況（最終行クリア）でしょうか？
一応、ちゃんとしたコードを以下に。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim c As Range
Dim a As Range
Set r = Intersect(Target, Columns("M"))
If r Is Nothing Then Exit Sub
With Range("A1", UsedRange)
With .Offset(2).Resize(.Rows.Count - 2).Columns("M")
.Cells.Interior.ColorIndex = xlNone
For Each c In .Cells
If WorksheetFunction.CountIfs(.Cells, c, .Cells.Offset(, -7), c.Offset(, -7)) > 1 Then
If a Is Nothing Then
Set a = c
Else
Set a = Union(a, c)
End If
End If
Next
End With
If Not a Is Nothing Then
a.Interior.ColorIndex = 6
End If
End With
End Sub
（β） 2015/07/13(月) 13:20
っていうか、全部作ってもらっちゃって、他力本願ですみませんでした。
（みか） 2015/07/13(月) 13:59
＞そちらで色が残るというのは、そういう状況（最終行クリア）でしょうか？
⇒（みか）途中のご質問に回答していませんでした。はい、最終行クリア、という状況でした。
頂いたマクロを他でも使いまわせそうなので、列の変え方を見てみました。
そこで質問があります。
（１）
With .Offset(2).Resize(.Rows.Count - 2).Columns("M")
↑項目の2行目までを対象外とし、重複ターゲットになるM列を指定する
これ、例えば3行目までを対象外とするなら、「With .Offset(3).Resize(.Rows.Count - 3).Columns("M")」とすればいいですよね？ 「With .Offset(3).Resize(.Rows.Count - 2).Columns("M")」にしても結果は同じになります。「(.Rows.Count - 2).」をいじらないでも結果は同じという意味です。
If WorksheetFunction.CountIfs(.Cells, c, .Cells.Offset(, -7), c.Offset(, -7)) > 1 Then
↑M列から左に7個目のF列を指定している
（２）今は該当シートに直接このコードを入れてマクロを使っていますが、標準モジュールに入れてワークシートを指定する場合、例えば「Worksheets("Sheet1").」は頂いたマクロのどこに追加すればいいでしょうか。
（３）M列に元々セルに色をつけていて、その色を残したい場合、どうすればいいでしょうか。勿論、重複があった場合は色が変わるとしてです。
よろしくお願いします。
（みか） 2015/07/14(火) 07:44
まず、With Range("A1", UsedRange) から説明します。
今回の場合、必ず A1 に値がありますので、ここは With UsedRange だけでもいいのですが、汎用的に使える記述として
A1 から という指定を入れてありますが、UsedRange というのは、そのシートで現在使われているセル群の「矩形の領域」です。
たとえば、B2:F20 とか。で、このばあい、A1からということにしてやると A1:F20 になります。
つまり、このシートのデータは20行あり、その下には何もない。F列まであり、その右には何もない。そういった領域になります。
で、その次の With .Offset(2).Resize(.Rows.Count - 2).Columns("M")
この With は、その上の領域規定、↑の例でいえば A1:F20 ですけど、それを２行下げた領域、つまり A3:F23、その Resize(行数)。
行数として .Rows.Count - 2 。この .（ピリオド）は、それ以前の With で指定されているものの という意味ですから A1:F20 の という意味になります。
A1:F20 の Rows.Count(行数) は 20 ですね。それから 2 を引いた 18。これが処理すべきデータ行の行数になります。
ですから、A3:F23から始まり行数が 18 の領域、つまり A3:F20 になります。で、その M列としていしていますので、最終的には M3:M20 になります。
ということで
>>3行目までを対象外とするなら、「With .Offset(3).Resize(.Rows.Count - 3).Columns("M")」
はい。正解です。
>>「With .Offset(3).Resize(.Rows.Count - 2).Columns("M")」にしても結果は同じになります。「(.Rows.Count - 2).」をいじらないでも結果は同じという意味です。
ちょっと違います。この場合、M4:M20 にならなければいけませんが、行数が１つ増えて、M4:M21 になります。 まぁ、もともと M21 は使っていないセルですから実害はないですが。
>>If WorksheetFunction.CountIfs(.Cells, c, .Cells.Offset(, -7), c.Offset(, -7)) > 1 Then >> ↑M列から左に7個目のF列を指定している
はい。基準セル.Offset(行数,列数) と記述します。行数、列数は、変更がなければ省略可能です。
基準セル.Offset(1,4) とすれば、基準セルから下に 1行、右に 4 列すすんだセル という意味になりますし 基準セル.Offset(,5) とすれば、基準セルと同じ行で、右に5 列すすんだセル という意味になります。
>>今は該当シートに直接このコードを入れてマクロを使っていますが、標準モジュールに入れてワークシートを指定する場合、
>>例えば「Worksheets("Sheet1").」は頂いたマクロのどこに追加すればいいでしょうか。
以下の質問の回答をもらえば、合わせてコード案をアップします。
>>M列に元々セルに色をつけていて、その色を残したい場合、どうすればいいでしょうか。勿論、重複があった場合は色が変わるとしてです。
これは結構厄介ですねぇ。 そのセルについている色が重複判定でつけられた色なのか、あるいは、それとは関係なく（重複していようがしていまいが）意識的に 操作でつけられたものなのか、マクロは判断できません。マクロだけではなく人間がみても判断できません。
もし、その時点で重複がないのに色がついていた。これは残す。そういうことならできますが。 要は、重複がない行につてはなにもしない（色を消さない）ということですが。 それでよろしいですか？
（β） 2015/07/14(火) 09:06
ご丁寧な説明ありがとうございます。
とても分かりやすいです。
＞要は、重複がない行につてはなにもしない（色を消さない）ということですが。
確かに色の判定は難しいですよね。ですので、仰る通り、重複がない行については何もしない（色を消さない）でお願いできますか。
色々すみません。
（みか） 2015/07/14(火) 12:57
書きましたが流してみると、やはり使い物になるかなぁと思います。 つまり、本当の重複で、どこか２行に重複があり色を付けた。 で、その重複をなくすため、一方のＭ列を直した。でも、２つのセルは色がついたまま。 で、実行。 重複はなくなっているけど、重複がないセルには何もしない。 そうすると、永久に色は消えない。
つまり、重複があれば色はつくけど、永久に消えず、重複のたびに色は増えていくので、いつかすべて色がつく？
やはり、ちょっと考え方に無理がありますねぇ。
たとえば、アップしたコード、重複があれば黄色にしています。 で、手でつける色は黄色以外にしておく。 コードでは、重複があれば黄色に塗る。 重複がなければ、そこに黄色以外の色がついていれば、それを尊重して何もしない。 黄色なら、色を消す。
このほうがいいのでは？ これをコードにすると以下になります。
Sub Test()
Dim r As Range
Dim c As Range
Dim a As Range
With Range("A1", ActiveSheet.UsedRange)
With .Offset(2).Resize(.Rows.Count - 2).Columns("M")
For Each c In .Cells
If WorksheetFunction.CountIfs(.Cells, c, .Cells.Offset(, -7), c.Offset(, -7)) > 1 Then
If a Is Nothing Then
Set a = c
Else
Set a = Union(a, c)
End If
Else
If c.Interior.ColorIndex = 6 Then c.Interior.ColorIndex = xlNone
End If
Next
End With
If Not a Is Nothing Then
a.Interior.ColorIndex = 6
End If
End With
End Sub
（β） 2015/07/14(火) 14:35
今まで頂いたコードを試してみましたが、今の私の仕事で運用する時に必要なのは、13(月) 13:20に頂いたコードでした。
このコードはＭ列を入力している最中に重複が分かり、重複の片方を消すと即 色も消えます。データ入力段階で重複が分かる事を何より求めていましたので、とても助かっています。（もう昨日から運用で使っています。）
そこで、大変申し訳ないのですが、この13(月) 13:20に頂いたコードに、「Worksheets("Sheet1").」を追加する位置を教えていただけないでしょうか。
（みか） 2015/07/14(火) 16:38
With をちょっと直すだけです。
Sub Test()
Dim r As Range
Dim c As Range
Dim a As Range
With Sheets("Sheet1").Range("A1", Sheets("Sheet1").UsedRange)
With .Offset(2).Resize(.Rows.Count - 2).Columns("M")
.Cells.Interior.ColorIndex = xlNone
For Each c In .Cells
If WorksheetFunction.CountIfs(.Cells, c, .Cells.Offset(, -7), c.Offset(, -7)) > 1 Then
If a Is Nothing Then
Set a = c
Else
Set a = Union(a, c)
End If
End If
Next
End With
If Not a Is Nothing Then
a.Interior.ColorIndex = 6
End If
End With
End Sub
（β） 2015/07/14(火) 17:01
なぜ、条件付き書式ではだめなのでしょうか。 マクロの勉強のためだけでもないようなので気になりました。 （マナ） 2015/07/14(火) 20:13
ですよねぇ。最初にも、そうコメントしているんですが、ましてや
★重複がなくなれば、元々色付きのセルは、その色に戻る
これは、条件付書式なら、当たり前の機能ですからねぇ。
（β） 2015/07/14(火) 20:34
条件付き書式…
すみません。βさんがはじめに仰ってましたね。マクロしか頭にありませんでした。
条件付き書式ですが、複数列の条件を満たす重複チェックもできるのでしょうか。ネットで色々調べたんですが見つけられませんでした。
下記なら、E2とE5に色がつくような。
A B C D E 1 日付 ID 住所 住所 名前 2 10001 ABCあいう 3 10002 TYUきき 4 10015 HYOらら 5 10001 ABCあいう 6 10020 KVRぽきき
（みか） 2015/07/14(火) 21:47
たとえば E列を選択して条件付き書式
数式が =COUNTIFS(B:B,B1,E:E,E1)>1 書式で好きな色を。
（β） 2015/07/14(火) 22:37
本当ですね。。
無知って恐ろしい。。
はじめのβさんのアドバイスをちゃんと聞くべきでした。
お忙しい中、何度も対応していただいて本当にありがとうございました。
ですが、今回のマクロは大変勉強になりました。
本当にありがとうございました。
（みか） 2015/07/15(水) 06:47
ご存知だったら教えていただきたいのですが、今回作成したマクロと条件付き書式だと、今後データが増えていく際に、ファイルが重くなる方はどちらでしょうか。
私はマクロの方が当然重くなると思っていたのですが、会社の方から条件付き書式の方が重くなる、と言われました。実際に同じファイルを条件付き書式と今回のマクロに設定して比較してもファイルサイズはほぼ同じでしたが。ネットで色々調べると、確かに条件付き書式で重くなる場合があると書いているのもあります。
（みか） 2015/07/15(水) 14:11
一般論としては、シート上にたくさんの関数、あるいは、多くの条件付書式を入れると、重くなります。 ただし、「たくさんの」です。しかも、「何もないものより比較として」であって、それで「足を引っ張ることになるかどうか」は、 どうでしょうねぇ、ないのでは？（少なくとも今回は）
エクセル内部の実際のデータの持ち方は、想像の世界でしかありませんが、条件付書式の場合は、適用領域に対して その条件を記憶していて、内部処理を行っているように思います。 セル毎に個別に設定すれば、設定セル数分の条件がそれぞれどこかに保持されますから大きくなるでしょうね。 ただし、今回の提案は 「E列」という「１つの適用領域」に対して設定していますから、1048576個の条件保持ではなく 「１個」の条件保持でまかなっているのではと思います。
むしろ、ファイルサイズというより関数にしろ、条件付書式の条件判定にしろ、裏で、常に、該当の領域に変更が加えられたかどうか、 それをウォッチしているタスクが動いているわけで、何もないよりは、重くなるといわれれば重くなるでしょう。
それが、どれくらい重くなるかということでしょうね。 そもそもが、これらとは比較にならないくらいの多くのオブジェクトがエクセル上に存在するわけで （たとえばシート上のセルというオブジェクトは 16384 x 1048576 個あって、それぞれウォッチャーが裏で動いているはずです） それらに比べて、E列に設定した１つの条件付書式が与える影響は微々たるものだと、個人的にはそう思っているんですが。
（β） 2015/07/15(水) 17:24
また詳しく説明してくださり、ありがとうございます。
テストで、今回のマクロと条件付き書式の二つのファイルに大量データを追加して比較したんですが、やはりサイズはあまり変わりませんでした。βさんのご説明でも納得できたのですっきりしました。
ありがとうございました！
（みか） 2015/07/15(水) 19:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.