0

Есть код (ниже), он запускает окно для выбора папки с файлами Excel, после открывает их в отдельных листах главной книги, и в каждом открытом листе производит форматирование (удалить строку 1, удалить столбец 2...).

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

Подскажите, как осуществить задуманное?

    Sub FileList()
        Dim V As String
        Dim BrowseFolder As String

        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Select folder"
            .Show
            V = .SelectedItems(1)
        End With
        BrowseFolder = CStr(V)

        ListFilesInFolder BrowseFolder
    End Sub


    Private Sub ListFilesInFolder(ByVal SourceFolderName As String)     
        Dim FSO As Object
        Dim SourceFolder As Object
        Dim FileItem As Object

        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set SourceFolder = FSO.getfolder(SourceFolderName)

        Application.ScreenUpdating = False

        For Each FileItem In SourceFolder.Files     
            Set importWB = Workbooks.Open(Filename:=FileItem)
            Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            importWB.Close savechanges:=False    
        Next FileItem

        Application.ScreenUpdating = True

        Dim ws As Worksheet

        Set wbCurrent = ActiveWorkbook
        Set wbReport = ActiveWorkbook

        For Each ws In wbCurrent.Worksheets           
            Cells.MergeCells = False
            ws.Rows("1:9").Delete
            ws.Rows("2").Delete
            ws.Rows("11").Delete
            ws.Range("A1,C1,D1,F1:H1,K1:M1,P1,S1,T1,V1,W1").EntireColumn.Delete

            Set c = Columns("A:A").Find("б/c")***           
        Next ws

        Set FileItem = Nothing
        Set SourceFolder = Nothing
        Set FSO = Nothing     
    End Sub

1 ответ 1

0

Находим в первом столбце последнюю строку с данными, поднимаемся выше, задаем количество удаляемых строк:

Dim lRw As Long

    For Each ws In wbCurrent.Worksheets
        With ws
            lRw = .Cells(.Rows.Count, 1).End(xlUp).row
            If lRw > 29 Then .Rows(lRw - 7).Resize(8).Delete

            .Cells.MergeCells = False
            .Rows("1:9").Delete
            .Rows("2").Delete
            .Rows("11").Delete
            .Range("A1,C1,D1,F1:H1,K1:M1,P1,S1,T1,V1,W1").EntireColumn.Delete
        End With
    Next FileItem

Важно: сначала удалить нижние строки, только после этого те, что выше.

Удаляем строки 1:9. После этого удаляем строку 2. Но фактически происходит удаление строки 11, которая переместилась на позицию 2 после удаления верхних строк. Далее удаляется строка 11 - та, которая изначально была под номером 21.

Правильно - удалять строки снизу вверх, столбцы - справа налево.

В Вашем коде разъединение ячеек выполняется а активном листе (Cells.MergeCells = False). Ошибка и не указан родительский лист?

Чтобы при открытии книг не мешали сообщения, их лучше отключить на время обработки файлов:

With Application
    .ScreenUpdating = False: .DisplayAlerts = False
End With

Включить перед завершением работы макроса.

Ваш ответ

Нажимая «Отправить ответ», вы соглашаетесь с условиями пользования и подтверждаете, что прочитали политику конфиденциальности.