您好我想知道是否有人對替換VBA 中的 Do Until 回圈有任何建議？
我的代碼（見下文），基本上查看單元格F4，如果單元格F4為0則選擇并洗掉該行。然后單元格向上移動，它再次回圈，直到 F4 大于零或為空。
該代碼實際上運行良好，但需要一段時間才能完成（猜測大約需要 3 分鐘）。我確實確保螢屏更新已關閉等，我只是沒有將其包含在此示例中。
我不會擔心在第一個實體中需要這么長時間，但最終它會在一次點擊中多次執行此搜索，一次可能多達 10K 個單元格，所以我希望它更活潑一點......
所以我的問題是除了 Do until 回圈之外我還能做什么？
Do Until Raw1.Range("F4") = "" Or Raw1.Range("F4") > 0
If Raw1.Range("F4").Value = 0 Then
Raw1.Range("A4:H4").Select
Selection.Delete Shift:=xlUp
End If
Loop
uj5u.com熱心網友回復：
使用自動篩選洗掉資料
- 從行開始
4（標題行是3），這將洗掉所有連續A:H的行范圍，其列F中的單元格值等于0（保留空白單元格）。
Option Explicit
Sub DeleteZeros()
' 'Raw1' is the code name of a worksheet in the workbook containing this code.
Const FirstCellAddress As String = "F3"
Const ColumnsAddress As String = "A:H"
If Raw1.FilterMode Then Raw1.ShowAllData
Dim crg As Range ' Column Range (Has Headers - 'F')
With Raw1.Range(FirstCellAddress)
Dim lRow As Long
lRow = Raw1.Cells(Raw1.Rows.Count, .Column).End(xlUp).Row
Dim rCount As Long: rCount = lRow - .Row 1
If rCount < 2 Then Exit Sub ' to few rows
Set crg = .Resize(rCount)
End With
Dim drg As Range ' Data Range (No Headers - 'A:H')
With crg
Set drg = .Resize(rCount - 1).Offset(1) _
.EntireRow.Columns(ColumnsAddress)
End With
Dim FirstDataRow As Long: FirstDataRow = drg.Row
' Filter Column Range
crg.AutoFilter 1, "0"
Dim vdrg As Range ' Visible Data Range (No Headers - 'A:H')
On Error Resume Next
Set vdrg = drg.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
Raw1.AutoFilterMode = False
' Delete
If vdrg Is Nothing Then Exit Sub
If vdrg.Cells(1).Row <> FirstDataRow Then Exit Sub
vdrg.Areas(1).Delete xlShiftUp
End Sub
uj5u.com熱心網友回復：
自下而上然后自上而下洗掉始終是更好的解決方案。
Sub deleteRows()
Const checkColumn As Long = 6 'Column F
Dim rg As Range
'!!!!!you will have to adjust this to your needs!!!!
Set rg = ActiveSheet.Cells(checkColumn, 4).CurrentRegion
Dim cntRows As Long
cntRows = rg.Rows.Count
Dim i As Long
For i = cntRows To 1 Step -1
If rg.Cells(i, checkColumn) = 0 Then
'rg.Rows(i).EntireRow.Delete xlShiftUp 'removes entire row
rg.Rows(i).Delete xlShiftUp 'removes only columns A-H
End If
Next
End Sub
uj5u.com熱心網友回復：
在 1 次操作中洗掉所有單元格更快。在我的示例代碼中，我讓一個跑步者找到最后一個有效單元格。我使用該單元格來確定需要洗掉的范圍的大小。
Sub RemoveEmptyRowsBasedOnColumnValues()
Dim CalculationMode As XlCalculation
CalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Cell As Range
With Raw1
For Each Cell In .Range("F4", .Cells(.Rows.count, "F").End(xlUp))
If Cell.Value > 0 Then
If Cell.Row > 3 Then
.Range("A4:H4").Resize(Cell.Row - 4).Delete Shift:=xlUp
End If
Exit For
End If
Next
End With
Application.Calculation = CalculationMode
End Sub
Function Raw1() As Worksheet
Set Raw1 = ThisWorkbook.Worksheets("Raw1")
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/436620.html