删除第一列以外的空白行

我写了一个macros来删除该行，如果它是一个空行，或者如果在B列中单元格包含stringXYZ。 但是，如果有200多行数据，则此macros可能需要几分钟才能运行。 任何人都可以提供更有效的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

首先，屏幕更新应该在处理之前closures，之后重新启用，这样屏幕不会闪烁，资源的负载也不会很高。

除此之外，在你的情况下，文本replace是完全不需要的。

通过阅读你当前的代码，我假设你考虑一个空行，如果它是列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 2

我会将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 

如你所见，整个macros运行， 然后closuresscreenUpdating。 你可以把它放在前面，然后在macros完成时再把它加速。

Answer 3

除了@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 4

这个解决scheme实际上应该是瞬间的：

 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 

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

这将使用范围对象的高级filter将您的logging过滤到与源数据相邻的范围内。 然后将结果复制到源而不使用剪贴板。 没有更快或更有效的方法来实现你的目标。