检查以下的代码,确认是否有bug,并分析改代码
Public Const sheetNameInfo = "抽出条件"
Public Const sampleSheetNameInfo = "20240402サンプル"
Public Const compareNameInfo = "ファイルの比較"
Public Const compareSampleNameInfo = "比較結果サンプル"
Public Const compareResultInfo = "比較結果"
Public Const compareStartCol = "B"
Public Const compareStartRowCol = "B5:C"
Sub CompareFileNameConsistency(ByVal baseSheetName As String)
Dim wsBase, wsExist, wsTemplate, wsNew As Worksheet
Dim arrBase, arrOther, arrTemplate
Dim dataColl As Collection, filesList As Collection
Dim i, cnt, arr(), lastRow, startCol, missingCount As Long
Dim arrResult() As Variant
Dim fileArr(1 To 8)
Dim key As String
'シートが存在時、シートが削除する
On Error Resume Next
Set wsExist = Worksheets(compareResultInfo)
If Not wsExist Is Nothing Then
Application.DisplayAlerts = False
wsExist.Delete
Application.DisplayAlerts = True
End If
On Error GoTo 0
Set wsTemplate = Nothing
On Error Resume Next
Set wsTemplate = Worksheets(compareSampleNameInfo)
On Error GoTo 0
If wsTemplate Is Nothing Then
MsgBox "シート「" & compareSampleNameInfo & "」が存在しない", vbExclamation
Exit Sub
End If
'シート(基準)のファイル名と更新日時
Set wsBase = Worksheets(baseSheetName)
arrBase = wsBase.Range(compareStartRowCol & wsBase.Cells(wsBase.Rows.Count, compareStartCol).End(xlUp).Row).Value
Set dataColl = New Collection
'固定シート以外のすべてのワークシートを繰り返し処理する
For Each ws In ThisWorkbook.Worksheets
If ws.Name = compareNameInfo Then
ElseIf ws.Name = compareSampleNameInfo Then
ElseIf ws.Name = sheetNameInfo Then
ElseIf ws.Name = sampleSheetNameInfo Then
ElseIf ws.Name = baseSheetName Then
Else
'ファイル名と時間の比較
arrOther = ws.Range(compareStartRowCol & ws.Cells(ws.Rows.Count, compareStartCol).End(xlUp).Row).Value
For i = 1 To UBound(arrOther, 1)
If Trim(arrOther(i, 1)) <> "" Then
dataColl.Add Array(ws.Name, arrOther(i, 1), arrOther(i, 2))
End If
Next
End If
Next
' dataCollからファイル名と時間を辞書に収集する
Dim dictExist As Object
Set dictExist = CreateObject("Scripting.Dictionary")
For i = 1 To dataColl.Count
key = CStr(dataColl(i)(1)) & "|" & CStr(dataColl(i)(2))
dictExist(key) = True
Next
missingCount = 0
For i = 1 To UBound(arrBase, 1)
If Trim(arrBase(i, 1)) <> "" Then ' ファイル名が存在する場合、
key = CStr(arrBase(i, 1)) & "|" & CStr(arrBase(i, 2))
If Not dictExist.Exists(key) Then
missingCount = missingCount + 1
dataColl.Add Array("", arrBase(i, 1), arrBase(i, 2))
dictExist(key) = True '重複追加を防止する
End If
End If
Next
cnt = dataColl.Count
If cnt > 0 Then
ReDim arrResult(1 To cnt, 1 To 3)
For i = 1 To cnt
arrResult(i, 1) = dataColl(i)(0) ' シート名
arrResult(i, 2) = dataColl(i)(1) ' ファイル名
arrResult(i, 3) = dataColl(i)(2) ' 更新日時
Next
End If
Set filesList = New Collection
For i = 1 To UBound(arrResult, 1)
fileArr(1) = arrResult(i, 1) 'シート名
fileArr(2) = arrResult(i, 2) 'ファイル名
fileArr(3) = arrResult(i, 3) ' 更新日時
For j = 1 To UBound(arrBase, 1)
If arrResult(i, 1) <> "" And arrResult(i, 2) = arrBase(j, 1) And arrResult(i, 3) = arrBase(j, 2) Then
fileArr(4) = baseSheetName ' シート名
fileArr(5) = arrBase(j, 1) ' ファイル名
fileArr(6) = arrBase(j, 2) ' 更新日時
fileArr(7) = "True" ' ファイル名の比較結果
fileArr(8) = "True" ' 更新日時の比較結果
Exit For
ElseIf arrResult(i, 1) <> "" And arrResult(i, 2) = arrBase(j, 1) And arrResult(i, 3) <> arrBase(j, 2) Then
fileArr(4) = baseSheetName ' シート名
fileArr(5) = arrBase(j, 1) ' ファイル名
fileArr(6) = arrBase(j, 2) ' 更新日時
fileArr(7) = "True" ' ファイル名の比較結果
fileArr(8) = "False" ' 更新日時の比較結果
Exit For
ElseIf arrResult(i, 1) = "" And arrResult(i, 2) = arrBase(j, 1) And arrResult(i, 3) = arrBase(j, 2) Then
fileArr(2) = "" 'ファイル名
fileArr(3) = "" ' 更新日時
fileArr(4) = baseSheetName ' シート名
fileArr(5) = arrBase(j, 1) ' ファイル名
fileArr(6) = arrBase(j, 2) ' 更新日時
fileArr(7) = "False" ' ファイル名の比較結果
fileArr(8) = "False" ' 更新日時の比較結果
Exit For
End If
Next
filesList.Add Array(fileArr(1), fileArr(2), fileArr(3), fileArr(4), fileArr(5), fileArr(6), fileArr(7), fileArr(8))
Next
'データを配列に格納する
ReDim arr(1 To filesList.Count, 1 To 8)
For i = 1 To filesList.Count
arr(i, 1) = filesList(i)(0) ' シート名1
arr(i, 2) = filesList(i)(1) ' ファイル名
arr(i, 3) = filesList(i)(2) ' 更新日時
arr(i, 4) = filesList(i)(3) ' シート名2
arr(i, 5) = filesList(i)(4) ' ファイル名
arr(i, 6) = filesList(i)(5) ' 更新日時
arr(i, 7) = filesList(i)(6) ' ファイル名の比較結果
arr(i, 8) = filesList(i)(7) ' 更新日時の比較結果
Next
'新しいシートを作成し
wsTemplate.Copy After:=Worksheets(Worksheets.Count)
Set wsNew = ActiveSheet
wsNew.Name = compareResultInfo
If Err.Number <> 0 Then
wsNew.Name = compareResultInfo & "_" & Format(Now, "hhmmss")
Err.Clear
End If
On Error GoTo 0
'シートにデータを書き込む
startCol = 2
lastRow = 5
For i = 1 To UBound(arr, 1)
wsNew.Cells(lastRow, startCol).Value = arr(i, 1) 'シート名1
wsNew.Cells(lastRow, startCol + 1).Value = arr(i, 2) 'ファイル名
wsNew.Cells(lastRow, startCol + 2).Value = arr(i, 3) ' 更新日時
wsNew.Cells(lastRow, startCol + 3).Value = arr(i, 4) 'シート名2
wsNew.Cells(lastRow, startCol + 4).Value = arr(i, 5) 'ファイル名
wsNew.Cells(lastRow, startCol + 5).Value = arr(i, 6) ' 更新日時
wsNew.Cells(lastRow, startCol + 6).Value = arr(i, 7) ' ファイル名の比較結果
wsNew.Cells(lastRow, startCol + 7).Value = arr(i, 8) ' 更新日時の比較結果
lastRow = lastRow + 1
Next
'列幅の自動調整
wsNew.Columns("B:I").AutoFit
'線の設定
Set rng = wsNew.Range(wsNew.Cells(5, startCol), wsNew.Cells(lastRow - 1, startCol + 7))
With rng.Borders
.LineStyle = xlContinuous
.Color = vbBlack
.Weight = xlThin
End With
'更新日時1列センター
With wsNew.Range(wsNew.Cells(5, startCol + 2), wsNew.Cells(lastRow - 1, startCol + 2))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.NumberFormat = "yyyy/mm/dd hh:mm:ss"
End With
'更新日時2列センター
With wsNew.Range(wsNew.Cells(5, startCol + 5), wsNew.Cells(lastRow - 1, startCol + 5))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.NumberFormat = "yyyy/mm/dd hh:mm:ss"
End With
End Sub