VBAエラー「インデックスが有効範囲にありません。」　一部PCのみ出る

Question

### 実現したいこと Excelシートを取り込み、条件に合うシートから指定した値を"【評価者入力用】評価シート"に転記 ### 発生している問題・分からないこと社内のいろんな人が使っていて問題なく使用できるのですが、一人だけずっと「インデックスが有効範囲にありません。」のエラーが出てしまいます。しかし、原因を調べるためにその方が持っているマクロ入りブックと取り込みたいブックをいただいてこちらで実行すると問題なく動くため、原因がわかりません。 ### エラーメッセージ ```error インデックスが有効範囲にありません。デバック↓ ' 既に開かれているブックであるかを確認 On Error Resume Next Set evalBook = Workbooks(fileNameOnly)　　←ここがハイライト On Error GoTo 0 ``` ### 該当のソースコード ```VBA Sub ImportChallengeSheetEvaluations() Dim wbHome As Workbook ' マクロが書かれているこのブック Dim wsMain As Worksheet Dim evalBook As Workbook Dim wsEval As Worksheet Dim selectedFile As Variant Dim lastRowMain As Long Dim empID As String, goalName As String Dim matchCount As Long, fileCount As Long Dim sheetCount As Long ' 識別子が一致したシートの数をカウント ' エラーシートを記録するコレクション Dim errorSheets As Collection ' 要素: Array(ファイルパス, シート名, エラーメッセージ) Dim errorSheetDetail As Variant Dim matchInCurrentSheet As Boolean Dim goalIndex As Long, rowOffset As Long Dim j As Long ' --- 1. メインシートの特定ロジック --- ' マクロが入っているこのブックを基準にする（アドイン・個人用マクロブック対策） Set wbHome = ThisWorkbook On Error Resume Next Set wsMain = wbHome.Sheets("【評価者入力用】評価シート") ' もし見つからない場合、念のため実行時のアクティブブックも探す If wsMain Is Nothing Then Set wsMain = ActiveWorkbook.Sheets("【評価者入力用】評価シート") Set wbHome = ActiveWorkbook End If On Error GoTo 0 If wsMain Is Nothing Then MsgBox "エラー：対象シート「【評価者入力用】評価シート」が見つかりません。" & vbCrLf & _ "マクロを実行しているファイルが正しいか確認してください。", vbCritical Exit Sub End If ' --- 2. 初期設定 --- lastRowMain = wsMain.Cells(wsMain.Rows.Count, "F").End(xlUp).Row matchCount = 0 fileCount = 0 sheetCount = 0 Set errorSheets = New Collection ' --- 3. ファイル選択ダイアログ --- With Application.FileDialog(msoFileDialogFilePicker) .Title = "チャレンジシートファイルを選択してください（複数選択可）" .Filters.Clear .Filters.Add "Excelファイル", "*.xls*" .Filters.Add "Excelファイル（全）", "*.xlsx;*.xlsm" .AllowMultiSelect = True If .Show <> -1 Then Exit Sub For Each selectedFile In .SelectedItems Dim fileNameOnly As String fileNameOnly = Mid(selectedFile, InStrRev(selectedFile, "\") + 1) Set evalBook = Nothing ' 既に開かれているブックであるかを確認 On Error Resume Next Set evalBook = Workbooks(fileNameOnly) On Error GoTo 0 If evalBook Is Nothing Then On Error Resume Next ' 他人が使用中でも開けるように読み取り専用で開く Set evalBook = Workbooks.Open(fileName:=selectedFile, ReadOnly:=True) If Err.Number <> 0 Then errorSheets.Add Array(selectedFile, "全シート", "ファイルを開く際にエラーが発生しました（破損やアクセス権等）") Err.Clear On Error GoTo 0 GoTo NextFile End If On Error GoTo 0 End If If evalBook Is Nothing Then GoTo NextFile fileCount = fileCount + 1 ' --- 4. 各シートの処理 --- For Each wsEval In evalBook.Worksheets If wsEval.Type = xlWorksheet Then ' B2セルの識別子をチェック If Trim(wsEval.Range("B2").Value) = "≪チャレンジシート≫" Then sheetCount = sheetCount + 1 matchInCurrentSheet = False ' 社員ID（L4セル）のエラー値チェック If IsError(wsEval.Range("L4").Value) Then empID = "" Else empID = Trim(wsEval.Range("L4").Value) End If If empID = "" Then errorSheets.Add Array(selectedFile, wsEval.Name, "社員ID（L4セル）が空またはエラー値です") GoTo NextSheet End If For goalIndex = 1 To 4 rowOffset = 10 + (goalIndex - 1) * 5 goalName = "目標" & goalIndex ' 評価項目の値を結合セルから取得（指定された最新の列位置） Dim weightVal As Variant, selfEval As Variant, eval1 As Variant Dim eval2 As Variant, eval3 As Variant, finalEval As Variant weightVal = wsEval.Cells(rowOffset, "D").MergeArea.Cells(1, 1).Value selfEval = wsEval.Cells(rowOffset, "W").MergeArea.Cells(1, 1).Value ' W列:自己 eval1 = wsEval.Cells(rowOffset, "Y").MergeArea.Cells(1, 1).Value ' Y列:1次 eval2 = wsEval.Cells(rowOffset, "Z").MergeArea.Cells(1, 1).Value ' Z列:2次 eval3 = wsEval.Cells(rowOffset, "AA").MergeArea.Cells(1, 1).Value ' AA列:3次 finalEval = wsEval.Cells(rowOffset, "AB").MergeArea.Cells(1, 1).Value ' AB列:最終 ' メインシート（wsMain）側の行を探索 For j = 1 To lastRowMain Dim actualEmpID As String Dim empIDCell As Range Set empIDCell = wsMain.Cells(j, 6).MergeArea.Cells(1, 1) ' F列（6） ' メインシート側の社員IDエラー値チェック If IsError(empIDCell.Value) Then actualEmpID = "" Else actualEmpID = Trim(empIDCell.Value) End If ' 社員IDと目標名が一致した場合のみ転記 If actualEmpID <> "" And actualEmpID = empID And Trim(wsMain.Cells(j, 14).Value) = goalName Then With wsMain .Cells(j, 13).Value = weightVal * 100 ' M列 .Cells(j, 15).Value = selfEval ' O列 .Cells(j, 16).Value = eval1 ' P列 .Cells(j, 17).Value = eval2 ' Q列 .Cells(j, 18).Value = eval3 ' R列 .Cells(j, 20).Value = finalEval ' T列 End With matchCount = matchCount + 1 matchInCurrentSheet = True Exit For End If Next j Next goalIndex If matchInCurrentSheet = False Then errorSheets.Add Array(selectedFile, wsEval.Name, "メインシートに該当する社員ID・目標が見つかりませんでした") End If Else ' 識別子が不一致だが空欄ではないシートはログに残す If Len(Trim(wsEval.Range("B2").Value)) > 0 Then errorSheets.Add Array(selectedFile, wsEval.Name, "識別子（B2セル）が不一致でした") End If End If End If NextSheet: Next wsEval ' 開いたブックを閉じる（マクロブック自身でない場合のみ） If Not evalBook Is Nothing Then If evalBook.Name <> wbHome.Name Then evalBook.Close SaveChanges:=False End If End If NextFile: Next selectedFile End With ' --- 5. エラーログの出力 --- Dim logSheet As Worksheet On Error Resume Next Set logSheet = wbHome.Sheets("取込エラー") If logSheet Is Nothing Then Set logSheet = wbHome.Sheets.Add(After:=wbHome.Sheets(wbHome.Sheets.Count)) logSheet.Name = "取込エラー" End If On Error GoTo 0 logSheet.Cells.ClearContents logSheet.Range("A1:C1").Value = Array("ファイル名", "シート名", "エラー内容") logSheet.Range("A1:C1").Font.Bold = True Dim r As Long: r = 2 For Each errorSheetDetail In errorSheets logSheet.Cells(r, 1).Value = Mid(errorSheetDetail(0), InStrRev(errorSheetDetail(0), "\") + 1) logSheet.Cells(r, 2).Value = errorSheetDetail(1) logSheet.Cells(r, 3).Value = errorSheetDetail(2) r = r + 1 Next logSheet.Columns("A:C").AutoFit ' --- 6. 完了報告 --- MsgBox "処理が完了しました。" & vbCrLf & vbCrLf & _ "識別子一致シート数: " & sheetCount & vbCrLf & _ "データ転記成功件数: " & matchCount & " 件" & vbCrLf & _ "エラー(スキップ)数 : " & errorSheets.Count & " 件", vbInformation End Sub ``` ### 試したこと・調べたこと - [x] teratailやGoogle等で検索した - [ ] ソースコードを自分なりに変更した - [ ] 知人に聞いた - [ ] その他 ##### 上記の詳細・結果このサイトの過去の質問に「ワークブックやワークシートの指定方法で、 Workbooksコレクションでワークブックを指定していますが、これが一番の原因」「アドインにすると、Excelのファイル名が変更されてしまう（正確には、拡張子が異なる）」とあったので、Geminiにて上記を盛り込んで再作成しましたが、解決しませんでした。 ### 補足ほぼ素人なため、元の作成自体もGeminiです。情報不足でしたら申し訳ございません。

Answer

> On Error Resume Next
> Set evalBook = Workbooks(fileNameOnly)　　←ここがハイライト
> On Error GoTo 0

1. Excel 上で Visual Basic Editor を開く。

2. メニューより[ツール]->[オプション]を開く。

3. [全般]タブ -> [エラートラップ]プロパティの設定値を確認する。

> 社内のいろんな人が使っていて問題なく使用できるのですが、
> 一人だけずっと「インデックスが有効範囲にありません。」のエラーが出てしまいます。

恐らくそのユーザーの環境では「エラー発生時に中断」となっているはず。
その場合は「エラー処理対象外のエラーで中断」に変更し、[OK]ボタンをクリックしてください。