Question

我在下面的代码中删除了工作簿中所有工作表的A列中的空行 - 而且效果很好。

代码：

Option Explicit

Sub DeleteBlankRows()

    Dim lRow As Long
    Dim iCntr As Long
    Dim ws As Worksheet
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("test.xlsm")

    wkbk1.Activate

    For Each ws In ThisWorkbook.Worksheets

        ' Find last row in column A
        lRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row

        For iCntr = lRow To 1 Step -1

            If IsEmpty(ws.Cells(iCntr, 1)) Or Trim(ws.Cells(iCntr, 1).Value) = "" Then

                ws.Rows(iCntr).Delete

            End If

        Next iCntr

    Next ws

End Sub

当我为不同的目的修改此代码时 - 要删除特定工作表的B列中的空白行，那么它只会陷入循环并且不会删除单行。

Option Explicit

Sub DeleteBlankRows()

    Dim lRow As Long
    Dim iCntr As Long
    Dim ws As Worksheet
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("test.xlsm")
    Set ws = wkbk1.Worksheets("sheet1")

    wkbk1.Activate
    ws.Activate

    With ws

        ' Find last row in column A
        lRow = ws.Range("B" & ws.Rows.count).End(xlUp).Row

        For iCntr = lRow To 1 Step -1

            If IsEmpty(ws.Cells(iCntr, 1)) Or Trim(ws.Cells(iCntr, 2).Value) = "" Then

                ws.Rows(iCntr).Delete

            End If

        Next iCntr

    End With

End Sub

我基本上需要帮助才能让代码执行而不会陷入循环并删除sheet1上B列中的空白行。

更新

如果有人想要测试文件本身，我已将示例文件上传到Google云端硬盘。

https://drive.google.com/file/d/1ImIqiA0znynSXAyZnUtpCG8mRIFlnXAl/view?usp=sharing

Answer 1

您仍在第一次检查中引用第1列（无论如何，这可能是多余的）。我已经建议了一种替代方法来删除更有效的行（Autofilter是另一种选择）。

Sub DeleteBlankRows()

Dim lRow As Long, iCntr As Long, ws As Worksheet, wkbk1 As Workbook, r As Range

Set wkbk1 = Workbooks("SampleBook.xlsm")
Set ws = wkbk1.Worksheets("HR")

Application.ScreenUpdating = False

With ws
    .AutoFilterMode = False
    .Range("A1").AutoFilter Field:=2, Criteria1:="="
    With .AutoFilter.Range
        On Error Resume Next
        Set r = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not r Is Nothing Then
            r.EntireRow.Delete shift:=xlUp
        End If
    End With
    .AutoFilterMode = False
End With

'With ws
'    lRow = .Range("B" & ws.Rows.Count).End(xlUp).Row
'    For iCntr = lRow To 1 Step -1
'        If Trim(.Cells(iCntr, 2).Value) = "" Then
'            If r Is Nothing Then
'                Set r = .Cells(iCntr, 2)
'            Else
'                Set r = Union(r, .Cells(iCntr, 2))
'            End If
'        End If
'    Next iCntr
'End With
'If Not r Is Nothing Then r.EntireRow.Delete shift:=xlUp

Application.ScreenUpdating = True

End Sub

VBA - 删除B列中的空行 - 卡在无限循环中

1 个答案: