For回圈洗掉具有特定單元格值條件的行

當第 7 列的單元格值為“否”時，我想洗掉整行，但效果不佳，因為即使單元格值為“否”，某些單元格也無法洗掉。該宏需要多次運行才能完全洗掉內容為“No”值的行

Sub Delete_Rows()
    Dim StartRow As Integer
    Dim LastRow As Integer
    Dim ColNum As Integer
    Dim CellVal As String

    ColNum = 7
    StartRow = 8

    Worksheets("Email_Status_Bonus").Activate
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For i = StartRow To LastRow
        CellVal = Cells(i, ColNum).Value
        If CellVal = "No" Then
            Cells(i, ColNum).EntireRow.Delete
        End If
        StartRow = StartRow   1
    Next i

End Sub

uj5u.com熱心網友回復：

洗掉資料行使用AutoFilter

• 不是整行！
• 假設資料右側至少有一個空列，資料下方至少有一個空行，即右側可能的資料將保持不變，而下方的行將向上移動與洗掉資料行一樣多的行。
• 第一個單元格左側或上方的可能資料將被忽略。

Option Explicit

Sub DeleteDataRows()
    
    Application.ScreenUpdating = False
    
    Dim dfrg As Range ' Data Filtered Range
    
    With ThisWorkbook.Worksheets("Email_Status_Bonus")
        ' Remove possible initial filter.
        If .FilterMode Then .ShowAllData
        ' Reference the range (has headers).
        Dim fCell As Range: Set fCell = .Range("A7")
        Dim rg As Range
        With fCell.CurrentRegion
            Set rg = fCell.Resize(.Row   .Rows.Count _
                - fCell.Row, .Column   .Columns.Count - fCell.Column)
        End With
        ' Reference the data range (no headers).
        Dim drg As Range: Set drg = rg.Resize(rg.Rows.Count - 1).Offset(1)
        ' Filter the range (has headers).
        rg.AutoFilter 7, "No"
        ' Attempt to reference the data filtered range (no headers).
        On Error Resume Next
            Set dfrg = drg.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        ' Remove the filter.
        .AutoFilterMode = False
    End With
    
    Dim IsSuccess As Boolean ' indicates if any rows were deleted
    
    ' Delete referenced filtered rows (if any).
    If Not dfrg Is Nothing Then
        dfrg.Delete xlShiftUp
        IsSuccess = True
    End If
    
    ' Save the workbook.
    'Thisworkbook.Save
    
    Application.ScreenUpdating = True
    
    ' Inform.
    If IsSuccess Then
        MsgBox "Data deleted.", vbInformation
    Else
        MsgBox "Nothing deleted.", vbExclamation
    End If

End Sub

uj5u.com熱心網友回復：

請嘗試下一個方法。它不需要向后迭代，就像在這種情況下應該做的那樣。它使用一個陣列、一個字典并且應該非常快。向后迭代的問題，如果一次洗掉每一行，會消耗 Excel 資源并使代碼變慢。下一個代碼創建一個字典Union范圍并在最后洗掉它：

Sub Delete_Rows_()
  Dim sh As Worksheet, lastRow As Long, arr, i As Long, dict As Object
  
  Set sh = ActiveSheet 'Worksheets("Email_Status_Bonus")
  lastRow = sh.cells(sh.rows.count, 7).End(xlUp).row
  arr = sh.Range("G1:G" & lastRow).value 'place the range in an array for faster iteration
  Set dict = CreateObject("Scripting.Dictionary")
  
  For i = 8 To UBound(arr)          'iterate beteen the array elements:
    If arr(i, 1) = "No" Then        'if condition is met:
        If Not dict.Exists(1) Then  'if dictionary with 1 key does  not exist:
            dict.Add 1, sh.Range("A" & i) 'create it, with a range as its item
        Else
            Set dict(1) = Union(dict(1), sh.Range("A" & i)) 'create a Union between existing and the new range
        End If
    End If
  Next i
  If Not dict(1) Is Nothing Then dict(1).EntireRow.Delete
End Sub

在這樣的目的中使用字典是一種奇特的方法……這是我第一次嘗試，看看它是如何作業的，就像一個實驗一樣。也可以Union直接設定范圍。

當您需要多個這樣的Union范圍但不知道需要多少個這樣的范圍時，可以使用字典方法。字典項可能包含一個范圍陣列，Union在需要時添加這些范圍......

uj5u.com熱心網友回復：

洗掉時，我們需要從最后一項（在本例中為一行）迭代到第一項。從范圍中洗掉一行會使下一行發生變化。

Sub Delete_Rows()
    Dim StartRow As Integer
    Dim LastRow As Integer
    Dim ColNum As Integer
    Dim CellVal As String
    
    ColNum = 7
    StartRow = 8
    
    Worksheets("Email_Status_Bonus").Activate
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For i = LastRow To StartRow Step -1
        CellVal = Cells(i, ColNum).Value
        If CellVal = "No" Then
            Cells(i, ColNum).EntireRow.Delete
        End If
        StartRow = StartRow   1
    Next i
    
End Sub

在連續的資料塊上使用Range.Autofilter將簡化并大大加快速度。

Sub DeleteVisisbleValues()
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Worksheets("Email_Status_Bonus")
        Rem Target A1 and all the contiguous (connected) data cells
        With Range("A1").CurrentRegion
            Rem Clears Existing Filter
            .AutoFilter
            
            Rem Apply Filter
            .AutoFilter 7, "No"
            
            Rem Delete Visible Rows
            .Offset(1).Delete
        End With
    End With
    
    Application.ScreenUpdating = True

End Sub

uj5u.com熱心網友回復：

您可以在“Cells(i, ColNum).EntireRow.Delete”之后插入“i = i - 1”，而不是向后回圈

uj5u.com熱心網友回復：

為什么你增加 StartRow ，在我看來，當宏找到“否”時，你必須減少“i”的 1 個值

Sub Delete_Rows()
    Dim StartRow As Integer
    Dim LastRow As Integer
    Dim ColNum As Integer
    Dim CellVal As String
    Dim i As Integer

    ColNum = 7
    StartRow = 8

    Worksheets("Sayfa2").Activate
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For i = StartRow To LastRow
        CellVal = Cells(i, ColNum).Value
        If CellVal = "No" Then
            Cells(i, ColNum).EntireRow.Delete
    i = i - 1
    End If
    Next i
End Sub

標籤：擅长 vba

上一篇：煩人的問題-WindowsApps加載Python安裝而不是用戶安裝的Python-在公司PC上無法更改環境變數-VBA

下一篇：NSInvalidArgumentException'，原因：從UIWebView遷移到WKWebView時“配置不能為零”