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

如你所知，整个宏运行，然后 screenUpdating被关闭。您可以通过将其放在前面，然后在宏完成时将其重新打开来加速它。

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

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

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

删除第一列以外的空白行

4 个答案: