Question

我想删除＆＃34;行范围＆＃34;如果一个单元格（列K8：Kxxxx）不是＆＃39;那么单元格并将它们向上移动，其他杂项簇＃34;

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

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(ActiveSheet.Range("K8"), ActiveSheet.Range("K8").End(xlDown))
   If Not (IsError(Application.Match(employeeId.Value, deleteIds, 0))) Then
       ActiveSheet.Range("G" & employeeId.Row).Value = ""
       ActiveSheet.Range("H" & employeeId.Row).Value = ""
       ActiveSheet.Range("I" & employeeId.Row).Value = ""
       ActiveSheet.Range("J" & employeeId.Row).Value = ""
       ActiveSheet.Range("K" & employeeId.Row).Value = ""
       ActiveSheet.Range("L" & employeeId.Row).Value = ""
   End If
Next

lastrow4 = Range("D:D").End(xlDown).Row
For i = lastrow4 To 1 Step -1
    If IsEmpty(Cells(i, "D").Value2) Then
        Cells(i, "G8:L50000").Delete Shift:=xlShiftUp
    End If
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox "DONE!"

这只是宏的一部分，我试图删除不符合条件的单元格。目前，宏寻找除了＆＃34; 06-Other ...＆＃34;之外的所有可能值。并清除G8：Lxxx范围内的细胞含量。但我无法删除并移动空白单元格。希望有人能解决我的问题。

Answer 1

您可以使用类型为DelRng DelRng Range, and every time it matches (or doesn't match) your criteria, you add this range to Union`功能的using the对象。

注意：尽量避免使用ActiveSheet，而是使用完全合格的Worksheets对象（请参阅下面的代码）：

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

Answer 2

这将删除并升级匹配条件后的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!"

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

2 个答案: