VBA根據單元格值洗掉行

我有一份包含 25K-30K 行的月度報告，我想根據單元格值從中洗掉行。該報告每個月的行數是動態的，但列數是固定的，從 A 到 X。我正在使用 For Next 回圈在單元格中搜索將觸發洗掉行的值，在作業表中“報告的資料”。此報告中有另一個名為“公共帳戶”的作業表，其中宏搜索并將標記（公共或私人）添加到“資料”作業表的每一行中。然后，它使用 For Next 回圈檢查幾個條件（例如，如果 R 和 S 列中的單元格的值相等，則洗掉該行），如果它們為真，則在報告的“資料”表中洗掉行。我的問題是在它的狀態下運行（10-15 分鐘）需要很長時間。你能幫我加快速度嗎？我附上了我正在使用的代碼。

Sub Format_Report()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Worksheets("Data").Activate
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("X2").Formula = "=if(isnumber(Match(A2,'Public accounts'!A:A,0)),""Public"",""Private"")"

Range("X2").AutoFill Destination:=Range("X2:X" & LR)

Last = Cells(Rows.Count, "A").End(xlUp).Row

For i = Last To 1 Step -1
    If (Cells(i, "R").Value) = (Cells(i, "S").Value) Then
           Cells(i, "A").EntireRow.Delete
           End If
         Next i

For i = Last To 1 Step -1
    If (Cells(i, "G").Value) = "ZRT" Then
           Cells(i, "A").EntireRow.Delete
           End If
         Next i

For i = Last To 1 Step -1
    If (Cells(i, "G").Value) = "ZAF" Then
           Cells(i, "A").EntireRow.Delete
           End If
         Next i

For i = Last To 1 Step -1
    If (Cells(i, "G").Value) = "E" Then
           Cells(i, "A").EntireRow.Delete
           End If
         Next i
 

           
For i = Last To 1 Step -1
    If Cells(i, 24) = "Public" Then
           Cells(i, 24).EntireRow.Delete
           End If
         Next i

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

uj5u.com熱心網友回復：

請測驗下一個代碼。它應該作業得非常快，使用陣列，一次排序，洗掉，使用并清除輔助排序列：

Sub Format_Report()
 Dim wsD As Worksheet, lastRD As Long, lastCol As Long
 Dim arr, arrMark, arrSort, i As Long, boolFound As Boolean

 Set wsD = ActiveSheet 'Worksheets("Data")
 lastRD = wsD.Range("A" & wsD.rows.count).End(xlUp).row
 lastCol = wsD.UsedRange.column   wsD.UsedRange.Columns.count   1
 arrSort = Evaluate("row(1:" & lastRD & ")") 'build an array to resort after deletion

 wsD.Range("X2:X" & lastRD).Formula = "=if(isnumber(Match(A2,'Public accounts'!A:A,0)),""Public"",""Private"")"
 wsD.Calculate

 arr = wsD.Range("G1:X" & lastRD).Value2 'place the range in an array for faster iteration
 ReDim arrMark(1 To UBound(arr), 1 To 1) 'reDim the array to keep deletion marks

 For i = 1 To lastRD
    If arr(i, 12) = arr(i, 13) And (arr(i, 12) <> "") Or _
           arr(i, 1) = "ZRT" Or _
           arr(i, 1) = "ZAF" Or _
           arr(i, 1) = "E" Or _
           arr(i, 18) = "Public" Then
       arrMark(i, 1) = "Del": boolFound = True 'write in array an boolFound = true to confirm at least a row to be deleted
    End If
 Next i
 Application.ScreenUpdating = False: Application.DisplayAlerts = False
  wsD.cells(1, lastCol).Resize(UBound(arrMark), 1).Value2 = arrMark 'drop arrMark content at once:
  wsD.cells(1, lastCol   1).Resize(UBound(arrSort), 1).Value2 = arrSort

  'sort the range based on arr column:
  wsD.Range("A1", wsD.cells(lastRD, lastCol   1)).Sort key1:=wsD.cells(1, lastCol), Order1:=xlAscending, Header:=xlNo ' sort the range by deletion column
  With wsD.cells(1, lastCol).Resize(lastRD, 1)
     If boolFound Then 'if at least a row to be deleted:
        .SpecialCells(xlCellTypeConstants).EntireRow.Delete
     End If
  End With
  'Resort the range based on arrSort column:
  wsD.Range("A1", wsD.cells(lastRD, lastCol   1)).Sort key1:=wsD.cells(1, lastCol), Order1:=xlAscending, Header:=xlNo
  wsD.cells(lastRD, lastCol   1).EntireColumn.ClearContents 'clear the column with the initial order
Application.ScreenUpdating = True: Application.DisplayAlerts = True
MsgBox "Ready..."
End Sub

標籤：擅长 vba for循环 优化 删除行

上一篇：回圈索引混亂

下一篇：以下Split函式中的(0)是什么意思？