Excel VBA - 删除空行

Cus*_*omX 14 excel vba 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
Run Code Online (Sandbox Code Playgroud)

Ale*_* K. 22

怎么样

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
Run Code Online (Sandbox Code Playgroud)


Sid*_*out 14

试试这个

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
Run Code Online (Sandbox Code Playgroud)

如果要删除整行,请使用此代码

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
Run Code Online (Sandbox Code Playgroud)

  • @Tom:它更长,因为我使用了正确的方法来进行所有错误处理的编码。无论如何,留下它;) (2认同)

小智 9

我知道我参加聚会迟到了,但这是我编写/使用的一些代码来完成这项工作。

Sub DeleteERows()
    Sheets("Sheet1").Select
    Range("a2:A15000").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Run Code Online (Sandbox Code Playgroud)