プロが教える店舗&オフィスのセキュリティ対策術

したいのです。

フォルダ内に集計用マクロファイルと個々人用の複数の回答ファイルがあります。
回答ファイル名は、「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 'マクロファイルのシート名は4月~3月の12枚です。
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

A 回答 (2件)

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



ThisWorkbook.Sheets(strMonth).Activate 'マクロファイルのシート名は4月~3月の12枚です。
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
    • good
    • 0
この回答へのお礼

luka3さま

ご回答ありがとうございます。
コードをコピペして、期待通りの結果でした♪
整理(整然)された読みやすいコードのご回答で助かりました。
コードを見て感動しました!
またご回答くださいませ♪<(_ _)>

お礼日時:2012/08/22 17:06

> 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 = ""
試行錯誤の跡?もう一息がんばってほしかった(--;
    • good
    • 0
この回答へのお礼

ap_2さま

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

お礼日時:2012/08/22 16:53

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!