根据指定内容删除-这次是3个条件

bavinfeather

test.rar (15.71 KB, 下载次数: 5)

2018-10-11 11:48 上传

点击文件名下载附件

需要删的有3种：

1、G 列为 2年前的数据
2、F列为 Cancelled 和 Rejected 的数据
3 I 列删除 CD 的数据


删除完了重新计算。。。
求助高手
命令如下，请协助修改


Sub vv_Click()
Application.ScreenUpdating = False
    Set Rng = Nothing
    With Sheets("vTigerReport")
        arr = .[a1].CurrentRegion
        dt = CDate(Year(Date) - 2 & "-" & Month(Date) & "-" & Day(Date))
        For j = 2 To UBound(arr)
            If dt - arr(j, 7) >= 0 Or arr(j, 6) = "Cancelled" Or arr(j, 6) = "Rejected" Then
                If Rng Is Nothing Then
                    Set Rng = .Cells(j, 1)
                Else
                    Set Rng = Union(Rng, .Cells(j, 1))
                End If
            End If
        Next j
        If Not Rng Is Nothing Then Rng.EntireRow.Delete
    End With
    Sheets("vTigerReport").Calculate
    Application.ScreenUpdating = True
End Sub

bavinfeather

顶…………………求助

liulang0808

If dt - arr(j, 7) >= 0 Or arr(j, 6) = "Cancelled" Or arr(j, 6) = "Rejected" Then
修改 If dt - arr(j, 7) >= 0 Or arr(j, 6) = "Cancelled" Or arr(j, 6) = "Rejected" or arr(j, 9) ="CD" Then

liulang0808

1. Sub 按钮1_Click()
   
2. Application.ScreenUpdating = False
   
3.     Set Rng = Nothing
   
4.     With Sheets("vTigerReport")
   
5.         arr = .[a1].CurrentRegion
   
6.         dt = CDate(Year(Date) - 2 & "-" & Month(Date) & "-" & Day(Date))
   
7.         For j = 2 To UBound(arr)
   
8.             If dt - arr(j, 7) >= 0 Or arr(j, 6) = "Cancelled" Or arr(j, 6) = "Rejected" Or arr(j, 9) = "CD" Then
   
9.                 If Rng Is Nothing Then
   
10.                     Set Rng = .Cells(j, 1)
    
11.                 Else
    
12.                     Set Rng = Union(Rng, .Cells(j, 1))
    
13.                 End If
    
14.             End If
    
15.         Next j
    
16.         If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
17.     End With
    
18.     Sheets("vTigerReport").Select
    
19.     Range("A2:C2").Select
    
20.     Selection.AutoFill Destination:=Range("A2:C30000")
    
21.     Sheets("vTigerReport").Calculate
    
22.     Application.ScreenUpdating = True
    
23. End Sub

复制代码