Подтвердить что ты не робот

Excel VBA - удаление пустых строк

Я хотел бы удалить пустые строки, создаваемые моей котировкой ERP. Я пытаюсь пройти через документ (A1:Z50) и для каждой строки, где нет данных в ячейках (A1-B1...Z1 = empty, A5-B5...Z5 = empty). Я хочу их удалить.

Я нашел это, но не могу настроить его для меня.

On Error Resume Next
Worksheet.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
4b9b3361

ОТВЕТЫ

Ответ 1

Как насчет

sub foo()
  dim r As Range, rows As Long, i As Long
  Set r = ActiveSheet.Range("A1:Z50")
  rows = r.rows.Count
  For i = rows To 1 Step (-1)
    If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
  Next
End Sub

Ответ 2

Попробуйте это

Option Explicit

Sub Sample()
    Dim i As Long
    Dim DelRange As Range

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    For i = 1 To 50
        If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = Range("A" & i & ":" & "Z" & i)
            Else
                Set DelRange = Union(DelRange, Range("A" & i & ":" & "Z" & i))
            End If
        End If
    Next i

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
    Application.ScreenUpdating = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Если вы хотите удалить всю строку, используйте этот код

Option Explicit

Sub Sample()
    Dim i As Long
    Dim DelRange As Range

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    For i = 1 To 50
        If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = Rows(i)
            Else
                Set DelRange = Union(DelRange, Rows(i))
            End If
        End If
    Next i

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
    Application.ScreenUpdating = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Ответ 3

Я знаю, что опаздываю на вечеринку, но вот код, который я написал/использовал, чтобы сделать работу.

Sub DeleteERows()
    Sheets("Sheet1").Select
    Range("a2:A15000").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Ответ 4

Чтобы сделать ответ Alex K более динамичным, вы можете использовать следующий код:

Sub DeleteBlankRows()

Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
    lngColCounter As Long
Dim blnAllBlank As Boolean
Dim UserInputSheet As String

UserInputSheet = Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from")

Set wks = Worksheets(UserInputSheet)

With wks
    'Now that our sheet is defined, we'll find the last row and last column
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByColumns, _
                             SearchDirection:=xlPrevious).Column

    'Since we need to delete rows, we start from the bottom and move up
    For lngIdx = lngLastRow To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngIdx, lngColCounter) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .rows(lngIdx).delete
        End If

    Next lngIdx
End With


MsgBox "Blank rows have been deleted."

 End Sub

Это было получено из этого веб-сайта, а затем слегка адаптировано, чтобы пользователь мог выбрать, какой рабочий лист они хотят удалить из удаленных строк.

Ответ 5

Это отлично сработало для меня (вы можете настроить lastrow и lastcol при необходимости):

Sub delete_rows_blank2()

t = 1
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count

Do Until t = lastrow

For j = 1 To lastcol
    'This only checks the first column because the "Else" statement below will skip to the next row if the first column has content.
    If Cells(t, j) = "" Then

        j = j + 1

            If j = lastcol Then
            Rows(t).Delete
            t = t + 1
            End If

    Else
    'Note that doing this row skip, may prevent user from checking other columns for blanks.
        t = t + 1

    End If

Next

Loop

End Sub

Ответ 6

Для того, чтобы функция "Возобновление при ошибке" работала, вы должны объявить значения книги и таблицы как таковые.

On Error Resume Next  
ActiveWorkbook.Worksheets("Sheet Name").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
On Error GoTo 0

У меня была та же проблема, и это исключило все пустые строки без необходимости реализации цикла For.

Ответ 7

для тех, кто заинтересован в удалении "пустых" и "пустых" строк (Ctrl + Shift + End, углубляясь в ваш рабочий лист)... вот мой код. Он найдет последнюю "настоящую" строку на каждом листе и удалит оставшиеся пустые строки.

Function XLBlank()
    For Each sh In ActiveWorkbook.Worksheets
        sh.Activate
        Cells(1, 1).Select
        lRow = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row

        Range("A" & lRow + 1, Range("A1").SpecialCells(xlCellTypeLastCell).Address).Select
        On Error Resume Next
        Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
        Cells(1, 1).Select
        ActiveWorkbook.Save
    Next
    ActiveWorkbook.Worksheets(1).Activate
    ActiveWorkbook.Save
End Function

Открыть VBA (ALT + F11), Вставить → Модуль, Скопируйте мой код и запустите его с помощью F5. Эт вуаля: D

Ответ 8

У меня есть еще один случай, когда вы хотите удалить только те строки, которые полностью пусты, но не одиночные пустые ячейки. Он также работает за пределами Excel, например при доступе к Excel через Access-VBA или VB6.

Public Sub DeleteEmptyRows(Sheet As Excel.Worksheet)
    Dim Row As Range
    Dim Index As Long
    Dim Count As Long

    If Sheet Is Nothing Then Exit Sub

    ' We are iterating across a collection where we delete elements on the way.
    ' So its safe to iterate from the end to the beginning to avoid index confusion.
    For Index = Sheet.UsedRange.Rows.Count To 1 Step -1
        Set Row = Sheet.UsedRange.Rows(Index)

        ' This construct is necessary because SpecialCells(xlCellTypeBlanks)
        ' always throws runtime errors if it does not find any empty cell.
        Count = 0
        On Error Resume Next
        Count = Row.SpecialCells(xlCellTypeBlanks).Count
        On Error GoTo 0

        If Count = Row.Cells.Count Then Row.Delete xlUp
    Next
End Sub