下標超出範圍 - 錯誤＃9

Question

運行以下代碼時，我收到Subscript out of range - error 9。有人能告訴我我做錯了什麼嗎？

Sub testing1() 
    Dim Fso As FileSystemObject 
    Dim Fldr As Folder 
    Dim Fpath As String 
    Dim Fl As File 
    Dim Sh As Worksheet 
    Dim cell As Range 
    Dim Myvalue As String 

    Application.DisplayAlerts = False 
    Myvalue = Application.InputBox("Enter your value") 

    Set Fso = New FileSystemObject 
    With Application.FileDialog(msoFileDialogFolderPicker) 
     .Show 
     Fpath = .SelectedItems(1) 
    End With 

    Set Fldr = Fso.GetFolder(Fpath) 

    For Each Fl In Fldr.Files 
     For Each Fl In Fldr.Files 
      For Each Sh In Workbooks(Fl.Name).Sheets 
       For Each cell In Sh.UsedRange 
        If cell.Value = Myvalue Then 
         cell.Interior.ColorIndex = 12 
        End If 
       Next cell 
      Next Sh 
     Next Fl 
    Next Fl 
End Sub 

Answer 1

不能更改關閉工作簿中的數據。你必須先打開它們。在循環中，您應該先嚐試打開工作簿，然後應用格式化，然後關閉它。請參閱以下代碼：

Sub testing1() 

    Dim TargetBook As Workbook 
    Dim Fso As FileSystemObject 
    Dim Fldr As Folder 
    Dim Fpath As String 
    Dim Fl As File 
    Dim Sh As Worksheet 
    Dim cell As Range 
    Dim Myvalue As String 

    Application.DisplayAlerts = False 
    Myvalue = Application.InputBox("Enter your value") 

    Set Fso = New FileSystemObject 
    With Application.FileDialog(msoFileDialogFolderPicker) 
     .Show 
     Fpath = .SelectedItems(1) 
    End With 
    Set Fldr = Fso.GetFolder(Fpath) 

    For Each Fl In Fldr.Files 
     Set TargetBook = Workbooks.Open(Fl.Name) '--Added this. 
     For Each Sh In TargetBook.Worksheets '--Changed this. 
      For Each cell In Sh.UsedRange 
       If cell.Value = Myvalue Then 
        cell.Interior.ColorIndex = 12 
       End If 
      Next cell 
     Next Sh 
     TargetBook.Close '--Added this. 
    Next Fl 

End Sub 

讓我們知道這是否有幫助。