ошибка выхода за пределы допустимого диапазона - макрос, который проходит через все файлы в папке - PullRequest
0 голосов
/ 21 марта 2019

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

1 Ответ

0 голосов
/ 21 марта 2019

Посмотрите, поможет ли это вам ...

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 Runtime

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...