Private Sub btnKouMoKuCheck_Click()
Dim pRow As Integer
Dim afName, lgNameStart, lgName, outPutInformation As String
Dim i As Integer
Dim j As Integer
Dim vntFileName As Variant
Dim vntGetFileName As Variant
'ファイルを開くダイアログを開きます
vntFileName = _
Application.GetOpenFilename( _
FileFilter:="エクセルファイル(*.xlsx),*.xlsx" & _
",CSVファイル(*.csv),*.csv" _
, FilterIndex:=1 _
, Title:="開けゴマ" _
, MultiSelect:=True _
)
'vntFileName = _
'Application.GetOpenFilename( _
FileFilter:="エクセルファイル(*.xlsx),*.xlsx" & _
",CSVファイル(*.csv),*.csv" _
, FilterIndex:=1 _
, Title:="開けゴマ" _
, MultiSelect:=True _
)
'ファイルが選択されているとき(vntFileNameが配列型)は
'選択した全てのファイルをWorkbooks.Openメソッドを使い開きます。
If IsArray(vntFileName) Then
For Each vntGetFileName In vntFileName
Workbooks.Open vntGetFileName
'ActionFrom項目一覧最終行を取得
pRow = 1
afName = "ActionFrom項目一覧"
Do While True
With Worksheets(afName).Cells(pRow, 1)
If .Value = "" Then
Exit Do
Else
pRow = pRow + 1
End If
End With
Loop
For i = 1 To pRow
lgNameStart = Worksheets(afName).Cells(i, 2)
For j = i + 1 To pRow
lgName = Worksheets(afName).Cells(j, 2)
'重複項目がある
If lgNameStart = lgName Then
outPutInformation = "ワークブック:" & vntGetFileName & "のワークシート:" & afName & i & "の" & lgNameStart & "と" & j & "重複しています、直してください。"
Else
'重複項目がない
j = j + 1
End If
Next
i = i + 1
Next
Workbooks.Close
Next
End If
If Len(outPutInformation) > 0 Then
MsgBox outPutInformation
Else
MsgBox "重複項目がありません、チェック正常終了"
End If
End Sub