下标超出范围 - 错误#9

时间:2013-12-13 09:00:47

标签: excel excel-vba vba

在运行下面提到的代码时,我收到了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

1 个答案:

答案 0 :(得分:2)

您无法更改已关闭工作簿中的数据。你必须先打开它们。在循环中,您应首先尝试打开工作簿,然后应用格式,然后关闭它。请参阅以下代码:

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

如果有帮助,请告诉我们。