Макрос VBA необходимо запустить дважды, чтобы удалить пустые строки из электронной таблицы

Question

Итак, я работал над макросом, который унаследовал от моего коллеги, который ушел.Проблема в том, что, включая основные данные, создается более миллиона пустых строк.Этот лист создан из исходного листа, состоящего из 30000 строк.

Я - нуб VBA, поэтому я изучал код по частям, надеясь понять его.Я работал над этим последние четыре часа, но я не добился никакого прогресса.Я решил сделать отдельный макрос, который удаляет пустые строки после факта.Есть только одна проблема: мне нужно запустить макрос дважды, чтобы избавиться от миллиона пустых строк.

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

Sub DeleteUnused()


Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range


For Each wks In ActiveWorkbook.Worksheets
  With wks
    myLastRow = 0
    myLastCol = 0
    Set dummyRng = .UsedRange
    On Error Resume Next
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
    myLastCol = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByColumns).Column
    On Error GoTo 0

    If myLastRow * myLastCol = 0 Then
        .Columns.Delete
    Else
        .Range(.Cells(myLastRow + 1, 1), _
          .Cells(.Rows.Count, 1)).EntireRow.Delete
        .Range(.Cells(1, myLastCol + 1), _
          .Cells(1, .Columns.Count)).EntireColumn.Delete
    End If
  End With
Next wks

End Sub

Answer 1

Вот макрос, который я использую для очистки всех пустых строк, а также пустых столбцов.

Вы можете решить, хотите ли вы удалять только пустые строки и сохранять пустые столбцы.

Sub Remove_Empty_Rows_And_Columns()

    Dim wks As Worksheet

    Dim row_rng As Range   'All empty rows will be collected here
    Dim col_rng As Range   'All empty columns will be collected here

    Dim last_row As Long    'points to the last row in the used range
    Dim last_column As Long 'points to the last column in the used range

    Dim i As Long           'iterator

    Set wks = ActiveSheet

    With wks

        'finding last row in used range
        last_row = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'finding last column
        last_column = .UsedRange.Columns(.UsedRange.Columns.Count).Column

        'loop through all rows in the used range and
        'find if current row is blank or not
        For i = 1 To last_row
            If Application.WorksheetFunction.CountA(.Rows(i)) = 0 Then
                'current row is blank..

                If row_rng Is Nothing Then
                    'this is the first blank row. Lets create a new range for it
                    Set row_rng = .Rows(i)
                Else
                    'this is not the first. Let's add it to the previous others
                    Set row_rng = Excel.Union(row_rng, .Rows(i))
                End If
            End If
        Next


        'same logic applies for empty rows
        For i = 1 To last_column
            If Application.WorksheetFunction.CountA(.Columns(i)) = 0 Then
                If col_rng Is Nothing Then
                    Set col_rng = .Columns(i)
                Else
                    Set col_rng = Excel.Union(col_rng, .Columns(i))
                End If
            End If

        Next

    End With


    'lets check if we managed to find any blank rows
    If Not row_rng Is Nothing Then
        row_rng.EntireRow.Delete
    Else
        MsgBox "no rows to delete"
    End If


    'checking if we found any empty columns
    If Not col_rng Is Nothing Then
       col_rng.EntireColumn.Delete
    Else
        MsgBox "no columns to delete"
    End If


End Sub

Answer 2

За мой комментарий это удалит пустые строки.Просто поместите это как последнюю строку макроса, который создал пустые строки.

Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete