この動作のコードを教えてください。ExcelVBA

質問

以下の動作をするためのコードを教えてください。
ExcelVBAでお願いします。

フォルダ１、2に入っているファイルが以下のようになっていた場合
フォルダ１
A.xlsx,B.xlsx,C.xlsx
フォルダ2
A.xlsx,C.xlsx,E.xlsx

B.xlsxはフォルダ2に存在しない
E.xlsxはフォルダ１に存在しない
とmsgboxを出したい。

ヒント：フォルダ１を指定したときにフォルダ内にあるExcelのファイル名を配列にいれる処理が必要

回答No.2

SI299792

すみません。前プログラムはバクあり、差し替えです。

Option Explicit
'
Sub Macro1()
　　Dim RInp As Long
　　Dim ROut As Long
　　Dim FileName As String
　　Dim OutData As String
　　Dim Delemeter As String
'
　　Range("C2:D" & Rows.Count).ClearContents
　　Application.ScreenUpdating = False
'
　　For RInp = 1 To 2
　　　　FileName = Cells(RInp, "B")
　　　　FileName = Dir(FileName & "\*.*")
'
　　　　While FileName > ""
　　　　　　ROut = Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　　　On Error Resume Next
　　　　　　ROut = [C:C].Find(FileName, LookAt:=xlWhole).Row
　　　　　　On Error GoTo 0
　　　　　　Cells(ROut, "C") = FileName
　　　　　　Cells(ROut, "D") = Cells(ROut, "D") + RInp
　　　　　　FileName = Dir
　　　　Wend
　　Next RInp
'
　　For RInp = 1 To 2
'
　　　　For ROut = 2 To Cells(Rows.Count, "C").End(xlUp).Row
'
　　　　　　If Cells(ROut, "D") = RInp Then
　　　　　　　　OutData = OutData & Delemeter & Cells(ROut, "C")
　　　　　　　　Delemeter = ","
　　　　　　End If
　　　　Next ROut
　　　　OutData = OutData & "は" & Cells(3 - RInp, "A") & "に存在しない"
　　　　Delemeter = vbCrLf
　　Next RInp
　　MsgBox OutData
End Sub

回答No.1

SI299792

画像の様に、
B1にフォルダ１を
B2にフォルダ２をフルパスで入力して下さい。

Option Explicit
'
Sub Macro1()
　　Dim RInp As Long
　　Dim ROut As Long
　　Dim FileName As String
　　Dim OutData As String
　　Dim Delemeter As String
'
　　Range("C2:D" & Rows.Count).ClearContents
'
　　For RInp = 1 To 2
　　　　FileName = Cells(RInp, "B")
　　　　FileName = Dir(FileName & "\*.*")
'
　　　　While FileName > ""
　　　　　　ROut = Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　　　On Error Resume Next
　　　　　　ROut = [C:C].Find(FileName, LookAt:=xlWhole).Row
　　　　　　On Error GoTo 0
　　　　　　Cells(ROut, "C") = FileName
　　　　　　Cells(ROut, "D") = Cells(ROut, "D") + RInp
　　　　　　FileName = Dir
　　　　Wend
　　Next RInp
'
　　For RInp = 2 To 1 Step -1
'
　　　　For ROut = 2 To Cells(Rows.Count, "C").End(xlUp).Row
'
　　　　　　If Cells(ROut, "D") = RInp Then
　　　　　　　　OutData = OutData & Delemeter & Cells(ROut, "C")
　　　　　　　　Delemeter = ","
　　　　　　End If
　　　　Next ROut
　　　　OutData = OutData & "は" & Cells(RInp, "A") & "に存在しない"
　　　　Delemeter = vbCrLf
　　Next RInp
　　MsgBox OutData
End Sub