Excel VBA-根据条件删除单元格范围

如果一个单元格（列K8:Kxxxx）不是“6-Other miscellaneous Cluster”，我想删除单元格的“行范围”并将其上移

---

这只是宏的一部分，我试图删除不符合条件的单元格。此时，宏将查找除“06 Other…”之外的所有可能值，并清除G8:Lxxx范围内单元格的内容。但我不能让它删除和转移空白单元格。希望有人能解决我的问题。

这将删除匹配条件后6列中的单元格并将其上移

    With wb2.Sheets("CALC")
             .Range("L8:L" & LastRow3).Formula = "=IF(G8="""","""",CONCATENATE(G8,""/"",VALUE(TEXT(I8,""00#""))))" 'REF'
        End With

Dim lStartRow As Long
Dim lEndRow As Long
Dim lSearchColumn As Integer
Dim lRow As Long

lStartRow = 8
lSearchColumn = 11
lEndRow = ActiveSheet.Range("K8").End(xlDown)

For lRow = lEndRow To lStartRow Step -1

    If Not (IsError(Application.Match(Cells(lRow, lSearchColumn), deleteIds, 0))) Then

        Cells(lRow, lSearchColumn + 1).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 2).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 3).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 4).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 5).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 6).Delete shift: xlShiftUp

    End If

Next



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "DONE!"

---

您可以使用

Range类型的
DelRng
对象，每次它匹配（或不匹配）您的条件时，您都可以使用

Union`函数将此范围添加到

DelRng

注意：尽量避免使用
ActiveSheet
，而是使用完全限定的
工作表
对象（请参见下面的代码）：

Dim DelRng As范围
使用此工作簿。工作表（“Sheet1”）“嘿，谢谢！但不知何故，他并没有删除所有其他不符合条件06-…-的行范围也不移动被删除的空白单元格。@ BuleSeCress尝试编辑代码，我只是用我的测试数据测试了它，它工作得很好，所以让我知道它也适用于YouWo过滤器工作，但它只删除内容而不是空白单元格。它还会删除单元格的格式。
    With wb2.Sheets("CALC")
             .Range("L8:L" & LastRow3).Formula = "=IF(G8="""","""",CONCATENATE(G8,""/"",VALUE(TEXT(I8,""00#""))))" 'REF'
        End With

Dim lStartRow As Long
Dim lEndRow As Long
Dim lSearchColumn As Integer
Dim lRow As Long

lStartRow = 8
lSearchColumn = 11
lEndRow = ActiveSheet.Range("K8").End(xlDown)

For lRow = lEndRow To lStartRow Step -1

    If Not (IsError(Application.Match(Cells(lRow, lSearchColumn), deleteIds, 0))) Then

        Cells(lRow, lSearchColumn + 1).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 2).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 3).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 4).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 5).Delete shift: xlShiftUp
        Cells(lRow, lSearchColumn + 6).Delete shift: xlShiftUp

    End If

Next



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "DONE!"

Dim DelRng As Range

With ThisWorkbook.Sheets("Sheet1") ' <-- modify "Sheet1" to your sheet's name
    deleteIds = Array("OTIF", "2-Stock Availability on Non Stock item", "1-Not in full or rejected", "3-Stock Availability on Stock item", "4-Credit Release after MAD", "5-Actual PGI after planned PGI") ' Put your employee ids in here
    For Each employeeId In .Range(.Range("K8"), .Range("K8").End(xlDown))
        If Not (IsError(Application.Match(employeeId.Value, deleteIds, 0))) Then
            If Not DelRng Is Nothing Then
                Set DelRng = Application.Union(DelRng, .Range(.Cells(employeeId.Row, "G"), .Cells(employeeId.Row, "L")))
            Else
                Set DelRng = .Range(.Cells(employeeId.Row, "G"), .Cells(employeeId.Row, "L"))
            End If
        End If
    Next
End With

' delete entire range at one-shot
If Not DelRng Is Nothing Then DelRng.Delete