エクセルVBAでフォルダ内の重複ファイルを表示

質問

したいのです。

フォルダ内に集計用マクロファイルと個々人用の複数の回答ファイルがあります。
回答ファイル名は、「AB1234.xls」と数字（ID）の部分は個々人で異なります。
集計用マクロファイルには、個々人のIDが記載されており、「*1234*.xls」とワイルドカードで集計する様にしています。
回答ファイルには「AB1234.xls」、「AB1234rev1.xls」、「AB1234rev2.xls」等が有る場合があり、集計前に重複ファイルを検索して処理を中断したいのです。

コードは下記の通りですが、重複ファイルのメッセージ表示が次の様になってしまいます。
AB1234.xls
AB1234rev1.xls

AB1234.xls
AB1234rev2.xls

AB5678.xls
AB5678rev1.xls

この表示を次の様にしたいのですが、どう手直しすれば宜しいでしょうか。
宜しくご回答願います。
AB1234.xls
AB1234rev1.xls
AB1234rev2.xls

AB5678.xls
AB5678rev1.xls

------------------------------------
ThisWorkbook.Sheets(strMonth).Activate　'マクロファイルのシート名は４月～３月の１２枚です。
MaxRow = Range("B4").End(xlDown).Row　'B4から下方に個々人のIDが記載されています。

For Y3 = 4 To MaxRow
strID = Cells(Y3, 2)
Cells(1, 6) = "プリチェック中"
i = 0
Target = Dir(ThisWorkbook.Path & "\" & "*" & strID & "*.xls", vbNormal)
msg1 = Target

Do While Target <> ""
i = i + 1
If i = 1 Then GoTo Label2
If i >= 2 Then
msg2 = msg2 & vbCrLf & vbCrLf & msg1 & vbCrLf & Target
Flag = Flag + 1
'ElseIf i = 1 Then
'msg1 = ""
End If
Label2:
Target = Dir()
Loop
Next Y3

If Flag >= 1 Then
Cells(1, 6) = ""
msg1 = "下記のファイルが重複しているので処理を中止します。" & msg2
MsgBox msg1
Exit Sub
Else
End If

回答No.2

luka3 · ベストアンサー

自分なりに整理して書き直してみました。

ThisWorkbook.Sheets(strMonth).Activate 'マクロファイルのシート名は４月～３月の１２枚です。
MaxRow = Range("B4").End(xlDown).Row 'B4から下方に個々人のIDが記載されています。
msg1 = ""

For Y3 = 4 To MaxRow
　strID = Cells(Y3, 2)
　Cells(1, 6) = "プリチェック中"
　Target = Dir(ThisWorkbook.Path & "\" & "*" & strID & "*.xls", vbNormal)
　msg2 = ""
　i = 0

　Do While Target <> ""
　　i = i + 1
　　msg2 = msg2 & Target & vbCrLf
　　Target = Dir()
　Loop
　If i > 1 Then msg1 = msg1 & msg2 & vbCrLf
Next Y3

If msg1 <> "" Then
　Cells(1, 6) = ""
　MsgBox "下記のファイルが重複しているので処理を中止します。" & vbCrLf & msg1
　Exit Sub
End If

お礼

luka3さま

ご回答ありがとうございます。
コードをコピペして、期待通りの結果でした♪
整理（整然）された読みやすいコードのご回答で助かりました。
コードを見て感動しました！
またご回答くださいませ♪＜（＿　＿）＞

回答No.1

ap_2

> msg2 = msg2 & vbCrLf & vbCrLf & msg1 & vbCrLf & Target
ファイル検出する度に、msg1（最初のファイル）と Target（検出したファイル）追加してますよね。2つめの時だけmsg1追加するとか・・・
　if i = 2 Then msg2 = msg2 & vbCrLf & vbCrLf & msg1
　msg2 = msg2 & vbCrLf & Target

> 'msg1 = ""
試行錯誤の跡？もう一息がんばってほしかった（－－；

お礼

ap_2さま

深夜のご回答ありがとうございます。
先のコード作成に３時間、ご察しの通り試行錯誤に２時間弱。。。
何が何だか分からなくなり質問した次第です。
またご回答下さいネ♪