Question

我正在尝试根据其值删除行（即，如果单元格包含单词DELETE），则应删除整行并向上移动。

我目前有代码可以遍历数据，并根据第4列中的日期将单元格值“ IN-SCOPE”或“ DELETE”应用于第11列。这可以正常工作-但是，我编写的代码删除所有标有“删除”的项目都无济于事。下面是我目前拥有的代码-任何帮助都将非常有用。

'Loop that lables items as in-scope IF they fall within the user defined range
    y = 2
    
StartDate = Controls.Cells(15, 10).Value
EndDate = Controls.Cells(15, 11).Value

    Bracknell.Activate
    Cells(1, 11).Value2 = "Scope Check"
        Do While Cells(y, 4).Value <> ""
            If Cells(y, 9).Value >= StartDate And Cells(y, 9).Value < EndDate Then
            Cells(y, 11).Value = "IN-SCOPE"
            Else: Cells(y, 11).Value = "DELETE"
        End If
    y = y + 1
    Loop

'Loop to delete out of scope items

    Bracknell.Activate
    
    z = 1

    Do While Cells(z, 4).Value <> ""
        If Cells(z, 11).Value = "DELETE" Then
        Range("A" & z).EntireRow.Delete shift:=xlUp
    End If
    z = z + 1
    Loop

Answer 1

尝试一下，代码是自我解释的：

Option Explicit
'use option explicit to force yourself
'to declare all your variables
Sub Test()
    
    'Loop that lables items as in-scope IF they fall within the user defined range
    Dim StartDate As Date
    StartDate = Controls.Cells(15, 10).Value
    Dim EndDate As Date
    EndDate = Controls.Cells(15, 11).Value
    
    With Bracknell
        'Instead deleting every row, store them into a range variable
        Dim RangeToDelete As Range
        'Calculate your last row with data
        Dim LastRow As Long
        'Assuming your column 4 has data on all the rows
        'If not, change that 4 for a column index that has data.
        LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
        'The most efficient way to loop through cells
        'is using For Each loop
        Dim cell As Range
        .Cells(1, 11) = "Scope Check"
        'loop through every row in column 4
        For Each cell In .Range(.Cells(2, 4), .Cells(LastRow, 4))
            'if the cell of that row in column 9 is between
            If .Cells(cell.Row, 9) >= StartDate And .Cells(cell.Row, 9) < EndDate Then
                .Cells(cell.Row, 11) = "IN-SCOPE"
            Else
            'if not, check if rangetodelete is empty
                If RangeToDelete Is Nothing Then
                    'if it is empty, set it as the cell
                    Set RangeToDelete = cell
                Else
                    'if not, set it as what it already is and the new cell
                    Set RangeToDelete = Union(RangeToDelete, cell)
                End If
            End If
        Next cell
        'Once you ended the loop you'll get the variable
        'with every cell that didn't meet your criteria
        'Check if is nothing, which means there are no cell to delete
        If Not RangeToDelete Is Nothing Then RangeToDelete.EntireRow.Delete
    End With

End Sub

根据单元格值删除整行

1 个答案: