下标超出范围错误，宏贯穿文件夹中的所有文件

Question

我可以在重写下面的代码时获得帮助，以便避免使用 ws As Worksheet ws = ThisWorkbook.Sheets（“ newreport”）'将工作表的名称更改为您要使用的工作表做代码

Dim arrData As Variant, LastRow As Long, i As Long, ws As Worksheet

    Set ws = ThisWorkbook.Sheets("newreport") 'change the name of the sheet to the one you are doing the code

    With ws
        LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        arrData = .Range("A2", .Cells(LastRow, "C")).Value
        For i = 1 To UBound(arrData)
            If arrData(i, 3) Like "Bus*" Then
                arrData(i, 1) = "XX XXX"
            Else
                arrData(i, 1) = "XXX XX"
            End If
            If arrData(i, 3) Like "CSI*" Or arrData(i, 3) = vbNullString Then
                arrData(i, 2) = vbNullString
            Else
                arrData(i, 2) = Right(arrData(i, 3), Len(arrData(i, 3)) - 12)
            End If
        Next i
        .Range("A2", .Cells(LastRow, "C")).Value = arrData
    End With

  For Each cell In Range("B2", Range("B605536").End(xlUp))
If Not IsEmpty(cell) Then
cell.Value = Right(cell, Len(cell) - 2)
End If
Next cell

Answer 1

看看这是否可以帮助您...

Public Sub OpenOtherWorkbooksAndProcess()
    Dim objDlg As FileDialog, strFolder As String, objFSO As Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder, objFile As Scripting.File, objBook As Workbook

    Set objFSO = New Scripting.FileSystemObject
    Set objDlg = Application.FileDialog(msoFileDialogFolderPicker)

    objDlg.Show

    If objDlg.SelectedItems.Count > 0 Then
        strFolder = objDlg.SelectedItems(1)

        Set objFolder = objFSO.GetFolder(strFolder)

        Application.ScreenUpdating = False

        For Each objFile In objFolder.Files
            ' You may want to change this to check for the type of files.
            ' The assumption is that all files within the selected folder are excel files.
            Set objBook = Excel.Workbooks.Open(objFile.Path)

            ' --------------------------------------------------------------------------
            ' ADD YOU LOGIC USING objBook AS YOUR SOURCE WORKBOOK
            ' --------------------------------------------------------------------------                

            objBook.Save
            objBook.Close
        Next

        Application.ScreenUpdating = True
    End If
End Sub

...有帮助吗？

可能需要进行调整以适应您的实际情况，但这是做您想做的基线（我认为）。

您将需要添加对库的引用，如下所示...