删除第一列以外的空白行

Question

我已经编写了一个宏来删除该行，如果它是一个空白行，或者如果 B 列中的单元格包含字符串 XYZ。但是，如果有 200 多行数据，此宏可能需要几分钟才能运行。谁能提供更有效的 VBA 格式？

Sub DeleteBlanks()

Dim lr As Long, r As Long
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
    Range("B" & r).Replace "*XYZ*", "", xlWhole
    If Range("B" & r).Value = "" Then
        Range("B" & r & ":Q" & r).Delete (xlShiftUp)
    End If
Next r

Application.ScreenUpdating = False

End Sub

Answer 1

我会将 ScreenUpdating 行添加到顶部，并将计算转为手动：

Sub DeleteBlanks()

Dim lr As Long, r As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
    Range("B" & r).Replace "*XYZ*", "", xlWhole
    If Range("B" & r).Value = "" Then
        Range("B" & r & ":Q" & r).Delete (xlShiftUp)
    End If
Next r

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

如您所见，整个宏运行，然后屏幕更新被关闭。您可以通过将其放在前面来加快速度，然后在宏完成后将其重新打开。

Answer 2

除了@BruceWayne说的，我再把代码缩短一下

 Range("B" & r).Replace "*XYZ*", "", xlWhole
    If Range("B" & r).Value = "" Then

与

If Range("B" & r).Value = "" Or InStr(1, Range("B" & r).Value, "XYZ") > 0 then

这将减少代码需要执行的操作。

Answer 3

首先，刷屏前要关闭刷屏，刷屏后重新开启，这样刷屏不会闪，资源负载也不会高。

除此之外，您的情况完全不需要文本替换。

通过阅读您当前的代码，如果 B 列为空，我假设您认为这是一个空白行。

试试这个：

Sub DeleteBlanks()

Application.ScreenUpdating = False
Dim lr As Long, r As Long
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
    If Range("B" & r).Value = "" Or Range("B" & r).Value Like "*XYZ*" Then
        Range("B" & r & ":Q" & r).Delete (xlShiftUp)
    End If
Next r
Application.ScreenUpdating = True


End Sub

Answer 4

这个解决方案几乎是瞬时的：

Public Sub Colin_H()
    Dim v, rCrit As Range, rData As Range
    With [a1]
        Set rData = .Resize(.Item(.Parent.Rows.Count).End(xlUp).Row, .Item(, .Parent.Columns.Count).End(xlToLeft).Column)
    End With
    Set rCrit = rData.Resize(2, 2).Offset(, rData.Columns.Count + 1)
        rCrit.Resize(1) = rData(1, 2): rCrit(2, 1) = "*": rCrit(2, 2) = "<>*xyz*"
    rData.AdvancedFilter xlFilterCopy, rCrit, rCrit.Resize(1, 1).Offset(, 2)
    With rCrit.Resize(1, 1).Offset(, 2).Resize(rData.Rows.Count, rData.Columns.Count)
        v = .Value2
        rData = v
        .ClearContents
        rCrit.ClearContents
    End With
End Sub

注意没有循环，没有行移动，也没有迭代范围构造。

这使用范围对象的高级过滤器来快速过滤您的记录到与源数据相邻的范围。然后在不使用剪贴板的情况下将结果复制到源上。没有更快或更有效的方法来实现您的 objective.

删除第一列以外的空白行

Delete blank rows other than first column

excel

vba

delete-row

is-empty

contain