求助，根据指定内容删除表格行

bavinfeather

求助 按钮在Sheet1  数据在 vTigerReport TEST.RAR (14.81 KB, 下载次数: 2)

2018-10-10 20:57 上传

点击文件名下载附件

需要删的有2种：

1、G 列为 2年前的数据
2、F列为 Cancelled 和 Rejected 的数据
删除完了重新计算。。。
求助高手

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" 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.    
    
19.     Application.ScreenUpdating = True
    
20. End Sub
    

复制代码

liulang0808

附件内容供参考。。。

bavinfeather

liulang0808 发表于 2018-10-10 21:18
附件内容供参考。。。

我修改成3个条件
结果无法实现。。。

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 = 3 To UBound(arr)
            If dt - arr(j, 7) >= 0 Or arr(j, 6) = "Cancelled" Or arr(j, 6) = "Rejected" Or arr(j, 9) = "EN" 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").Select
    Range("A2:C2").Select
    Selection.AutoFill Destination:=Range("A2:C30000")
    Sheets("vTigerReport").Calculate
    Application.ScreenUpdating = True
End Sub


求助

liulang0808

bavinfeather 发表于 2018-10-11 14:38
我修改成3个条件
结果无法实现。。。

建议上传附件，结合附件内容说明下

bavinfeather

liulang0808 发表于 2018-10-11 14:48
建议上传附件，结合附件内容说明下

http://club.excelhome.net/forum.php?mod=viewthread&tid=1439871&mobile=2

liulang0808

bavinfeather 发表于 2018-10-12 19:06
http://club.excelhome.net/forum.php?mod=viewthread&tid=1439871&mobile=2

附加跟帖上传就可以了吧，