複数のExcelファイルをマージするマクロ(修正)

' === 他のファイルを順にマージ（Aさん以外） ===
For Each file In files
If file.Path <> baseFile And LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then

Dim matchName As String: matchName = ""
Dim arrNames As Variant: arrNames = ConstNames()
Dim n As Long
For n = LBound(arrNames) To UBound(arrNames)
If InStr(file.Name, arrNames(n)) > 0 Then
matchName = arrNames(n)
Exit For
End If
Next n

' 対象人物が見つからなければスキップ
If matchName = "" Then GoTo SkipFile

Set mergeWorkbook = Workbooks.Open(file.Path)
Set wsOther = mergeWorkbook.Sheets(1)
Dim lastRowOther As Long: lastRowOther = wsOther.Cells(wsOther.Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRowOther
' 作業者が一致しない行はスキップ
If InStr(wsOther.Cells(i, 4).Value, matchName) = 0 Then GoTo SkipRow

key = GetRowKey(wsOther, i)

If dictBase.exists(key) Then
' === 既存行：値と書式の更新 ===
Dim rowBase As Long: rowBase = dictBase(key)
Dim col As Long
For col = 5 To 6
If wsBase.Cells(rowBase, col).Value <> wsOther.Cells(i, col).Value Then
wsBase.Cells(rowBase, col).Value = wsOther.Cells(i, col).Value
With wsBase.Cells(rowBase, col)
.Font.Bold = wsOther.Cells(i, col).Font.Bold
.Font.Italic = wsOther.Cells(i, col).Font.Italic
.Font.Color = wsOther.Cells(i, col).Font.Color
.Interior.Color = wsOther.Cells(i, col).Interior.Color
.Font.Size = wsOther.Cells(i, col).Font.Size
.Font.Name = wsOther.Cells(i, col).Font.Name
End With
End If
Next col
Else
' === 新規行：正しい位置に挿入 ===
Dim insertRow As Long
insertRow = FindInsertPosition(wsBase, dictBase, wsOther, i)

wsBase.Rows(insertRow).Insert Shift:=xlDown
wsOther.Rows(i).Copy
wsBase.Rows(insertRow).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Application.CutCopyMode = False

Dim j As Variant
For Each j In dictBase.Keys
If dictBase(j) >= insertRow Then
dictBase(j) = dictBase(j) + 1
End If
Next j
dictBase.Add key, insertRow
lastRowBase = lastRowBase + 1
End If

SkipRow:
Next i

mergeWorkbook.Close False
SkipFile:
End If
Next

Function ConstNames() As Variant
' 作業者名のリストを定数として返す
ConstNames = Array("Aさん", "Bさん", "Cさん")
End Function

No.1 回答者： 2度寝でgoo 回答日時： 2025/06/05 07:40

何のために必要なのか、この目的が見えない