エクセルマクロ：複数列 重複があった場合、メッセージと印入れる方法

いつもお世話になっております。
マクロについて行き詰まったので質問させてください。

管理票データがあって
Ａ列～時間
Ｂ列～管理番号
Ｃ列～処理区分
Ｄ列～担当者名
Ｅ列～処理
Ｆ列～記事欄
Ｇ列以降は空き列

Ｂ列の管理番号に重複があった場合、
メッセージで知らせるマクロはネットを参考に使用させて頂いたのですが、

Ａ列とＢ列とＣ列が一致したものが
同じ行にあった場合、メッセージで知らせると同時に
Ｇ列に重複している箇所に☆マークを入れるマクロに変えようとしましたが
複数列になるとマクロの書き方が今一わかりません。

色々、調べた結果
dicで格納させて、まとめてみるという方法があるようですが、
行き詰まってしまったので、どなたか、
良い方法があれば教えて頂けませんか？


下記に使わせてもらっているマクロのコードと
概要と添付にて図を表示します。
お手数ですが、宜しくお願い致します。


　　　　Ａ列　　　　　　Ｂ列 　　C列　　　Ｄ列　　　Ｅ列 　F列　　　Ｇ列～以降空き

1　　　　時間　　　　　 管理番号　　　区分　　 担当者　　 処理　　記事欄
2 2015/09/01 10：00　 D12345　　新規申込 ○○○ 確認中　　　　　　　☆　
3 2015/09/01 10：10　 D12346　　新規申込 ○○○ 確認中　　
4 2015/09/01 10：11　 D12347　　新規申込 ○○○ 確認中　　
5 2015/09/01 10：00　 D12345　　新規申込 ○○○ 確認中　　　　　　　☆


Ａ列とＢ列とＣ列が一致したもの
（2015/09/01 10：00　 D12345　　新規申込 ）と記述しているものが
2行目と5行目にあった場合、メッセージで表示させると同時に
Ｇ列に☆をいれる。




Option Explicit
Sub 重複チェック()

Dim i As Long
Dim j As Long
Dim z As Long
Dim Kanri As String
Dim cnt As Long
cnt = 0
With Sheets("管理票")
z = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To z
For j = i + 1 To z
If .Cells(i, 2).Value = .Cells(j, 2).Value Then
Kanri = .Cells(i, 2).Value
cnt = cnt + 1
MsgBox "下記の管理番号が重複しています" & vbCrLf & Kanri
Exit For
End If
Next j
Next i
If cnt = 0 Then

Exit Sub
End If
End With
End Sub

No.3 ベストアンサー 回答者： 30246kiku 回答日時： 2015/09/06 05:22

以下でどうなりますか

Option Explicit

Public Sub Samp1()
　　Dim dic As Object, dicE As Object
　　Dim vA As Variant
　　Dim sS As String
　　Dim i As Long, j As Long
　　Const CMK As String = "☆"

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set dicE = CreateObject("Scripting.Dictionary")

　　With Worksheets("管理票")
　　　　With .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 3)
　　　　　　vA = .Value
　　　　　　For i = 1 To UBound(vA)
　　　　　　　　sS = ""
　　　　　　　　For j = 1 To UBound(vA, 2)
　　　　　　　　　　sS = sS & "_" & vA(i, j)
　　　　　　　　Next
　　　　　　　　If (dic.Exists(sS)) Then
　　　　　　　　　　vA(i, 1) = CMK
　　　　　　　　　　vA(dic(sS), 1) = CMK
　　　　　　　　　　dicE(vA(i, 2)) = Empty
　　　　　　　　Else
　　　　　　　　　　vA(i, 1) = Empty
　　　　　　　　　　dic(sS) = i
　　　　　　　　End If
　　　　　　Next
　　　　　　.Columns(1).Offset(, 6).Value = vA
　　　　End With
　　　　If (dicE.Count > 0) Then
　　　　　　.Activate
　　　　　　MsgBox "下記の管理番号が重複しています" & vbCrLf & vbCrLf _
　　　　　　　　　　& Join(dicE.Keys, vbCrLf)
　　　　End If
　　End With

　　Set dic = Nothing
　　Set dicE = Nothing
End Sub


重複チェックする部分を vA に読み込みます
（A2 ～ A最終行範囲の３列分）
行単位で１つの文字列 sS を作成して（列間に "_" ）
その文字列が dic にあるか確認して
・あったら、
今の行と dic に覚えていた行の１列目に ☆
メッセージ用に管理番号を dicE のキーとして覚えておく
（同じ管理番号が何度も重複して出現した際に１つにするため）
・なかったら
今の行を覚え、１列目をきれいに（ Empty ）しておく

これは、結果出力用に vA １列目を使いまわしするため
（そもそも vA の内容は dic に覚えてしまうと不要になるので）

上記処理が終わったら、
>　　　　　　.Columns(1).Offset(, 6).Value = vA
１列目基準の Offset で G 列指定して 結果出力
３列ある vA を代入しても左辺は１列分しかないので１列分だけ出力
シートへの書き出しは、この１回だけなので
Application.ScreenUpdating での描画云々は不要と思います

dicE の中身がカラでなかったら重複があったことになるから
管理票を見せつつメッセージの出力


ってな流れになります

この回答へのお礼

重複している管理番号を1度に表示できるのと、
重複箇所にマークをつけるのが全て確認できました。

Ｄｉｃの使い方について、
色々と勉強になる事ばかりです。

関数とマクロについての回答を色々な方に記述してもらい
ありがたい限りです。

30246kiku様のコードをベストアンサーとさせて頂きます。
皆様、色々とありがとうございます

お礼日時：2015/09/06 09:16

No.2 回答者： WindFaller 回答日時： 2015/09/06 02:38

こんばんは。

もし、純粋に本格的に、ご質問の問題を解決するためには、アルゴリズムが必要だと思います。マクロの勉強のためには、本当はそちらのほうがよいのですが、そういうコードを書く人は、めったにいません。

#1の方がおっしゃっている方法をマクロに組み入れても可能ですが、お分かりになりますか？
多くの人は、実務的にそういう使い方をしているようです。
関数は、COUNTIF()関数を使います。
かなり独特の書き方になります。

とりあえず、以下を先にします。
>dicで格納させて、まとめてみるという方法があるようですが、
>行き詰まってしまったので、

Dictionary オブジェクトの使い方は、少しレベルが上がるかもしれませんね。中級クラスかもしれません。

'//
Sub DoublingFind()
　Dim myDic As Object
　Dim i As Long, j As Long
　Set myDic = CreateObject("Scripting.Dictionary")
　Application.ScreenUpdating = False
　On Error Resume Next
　With Worksheets("管理票") '
　　For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
　　　myDic.Add .Cells(i, 2).Value, i　'Key と 行数
　　　If Err() <> 0 Then
　　　　j = myDic.Item(.Cells(i, 2).Value)
　　　　If .Cells(j, 7).Value = "" Then　'最初に印
　　　　　.Cells(j, 7).Value = "☆"
　　　　End If
　　　　.Cells(i, 7).Value = "☆"　'見つけたものにも印
　　　　Err.Clear　'これがないと、エラー値が残ってしまいます。
　　　End If
　　Next i
　End With
　On Error GoTo 0
　Application.ScreenUpdating = True
End Sub
'///

'関数を使った方法(定番)

Sub DoublingFind_whFunc()
　With Worksheets("管理票")
　 With .Range("B2", .Cells(Rows.Count, "B").End(xlUp))
　　.Offset(, 5).FormulaLocal = "=IF(COUNTIF(" & .Address & ",B2)>1 ,""☆"","""")"
　　.Offset(, 5).Value = .Offset(, 5).Value
　　End With
　End With
End Sub

No.1 回答者： izayoimizuki 回答日時： 2015/09/05 22:24

マクロ使うほど複雑な処理かな…？という印象なので観衆でやる方法を。

H列以降の適当なセル（今回はH2で説明）に=A2&B2&C2と記載しオートフィルします。
G2セルで=if(count(H:H,H2)>1,"☆","")と記載しオートフィル。
これであなたが必要としている目的は達成できます。