刪除第一列以外的空白行

如果是空行，或者在列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

來源

2015-10-15 Colin Hawthorne

正如其他人所說，關閉屏幕更新開始。另外，如果範圍內有任何公式，計算模式爲手動。 –

首先，應該先關閉屏幕更新，然後重新啓用，這樣屏幕不會閃爍，資源的負載也不會很高。

除此之外，在你的情況下，文本替換是完全不需要的。

通過閱讀你當前的代碼，我假設你認爲一個空行，如果是在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

來源

2015-10-15 15:27:16

我想補充的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被關閉。您可以將它放在最前面，然後在宏完成時將其重新打開。

來源

2015-10-15 15:21:11 BruceWayne

除了什麼@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

的代碼需要做出會降低動作。

來源

2015-10-15 15:26:28 Balinti

雖然你的想法確實是一種改進，但它並不是最優的。由於VBA不會進行短路評估，因此總是會評估「Or」兩側的表達式，並提出您的提議。在這種情況下，最佳重構是使用'Select Case True'。 –

這個解決方案應該是幾乎瞬時：

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

請注意，沒有循環，沒有行移動，也沒有迭代範圍構造。

這使用範圍對象的高級過濾器將您的記錄過濾到與源數據相鄰的範圍內。然後將結果複製到源而不使用剪貼板。沒有更快或更有效的方式來實現您的目標。

來源

2015-10-15 15:52:10

@ColinHawthorne如果你仍然需要幫助，我會在這裏提供幫助。 –

刪除第一列以外的空白行

回答

相關問題