ошибка выхода индекса за пределы диапазона, макрос, который выполняется через все файлы в папке

#excel #vba

#excel #vba

Вопрос:

Могу ли я, пожалуйста, получить помощь в переписывании кода, прикрепленного ниже, чтобы я мог избежать использования ws в качестве рабочего листа 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
  

Комментарии:

1. Вы имеете в виду, что хотите перебирать несколько листов в одной книге и применять одну и ту же логику?

2. @BradDixon эй, Брэд, нет. Цель состоит в том, чтобы сохранить макрос в файле Excel. Пользователь сохраняет другой файл в папку. Затем этот пользователь откроет файл Excel с помощью макроса, запустит его. который запустит макрос для файла в папке.

3. хорошо, понял, спасибо.

Ответ №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
  

… помогает ли это?

Возможно, потребуются настройки для удовлетворения вашего конкретного сценария, но это базовая линия для выполнения того, что (я думаю) вы хотите.

Вам нужно будет добавить ссылку на библиотеку, как показано ниже…

Среда выполнения Microsoft Scripting