[已解决]删除不固定行数

跑跑2014

AF列的数值是有规律的，都是在D列各工地汇总数值那行，也就是说AF列的数值见零，就把相对应的整个工地全部内容删除。
这个希望 大侠可用代码帮我写出。一下子把为零值的工地全部删除掉。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-4-14 00:09

1. Sub test()
   
2.     Dim arr, i&
   
3.     Dim rg As Range
   
4.     Dim lRow&
   
5.     arr = Range("af1:ag" & Cells(Rows.Count, "af").End(xlUp).Row).Value
   
6.     For i = UBound(arr) To 2 Step -1
   
7.         If arr(i, 1) = 0 And Not IsEmpty(arr(i, 1)) Then
   
8.             lRow = Cells(i, "af").End(xlUp).Row
   
9.             If lRow = 1 Then
   
10.                 lRow = 2
    
11.             Else
    
12.                 lRow = lRow + 3
    
13.             End If
    
14.             If rg Is Nothing Then
    
15.                 Set rg = Rows(i + 2 & ":" & lRow)
    
16.             Else
    
17.                 Set rg = Union(rg, Rows(i + 2 & ":" & lRow))
    
18.             End If
    
19.         End If
    
20.     Next
    
21.     If rg Is Nothing Then Exit Sub
    
22.     Application.ScreenUpdating = False
    
23.     Application.DisplayAlerts = False
    
24.     rg.Delete
    
25.     Application.DisplayAlerts = True
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "删除完成"
    
28. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

删除承租单位与合并金额之间的所有行吧？

hwc2ycy

1. Sub test()
   
2.     Dim arr, i&
   
3.     Dim rg As Range
   
4.     Dim lRow&
   
5.     arr = Range("af1:ag" & Cells(Rows.Count, "af").End(xlUp).Row).Value
   
6.     For i = UBound(arr) To 2 Step -1
   
7.         If arr(i, 1) = 0 And Not IsEmpty(arr(i, 1)) Then
   
8.             lRow = Cells(i, "af").End(xlUp).Row
   
9.             If lRow = 1 Then
   
10.                 lRow = 2
    
11.             Else
    
12.                 lRow = lRow + 3
    
13.             End If
    
14.             If rg Is Nothing Then
    
15.                 Set rg = Rows(i + 2 & ":" & lRow)
    
16.             Else
    
17.                 Set rg = Union(rg, Rows(i + 2 & ":" & lRow))
    
18.             End If
    
19.         End If
    
20.     Next
    
21.     If rg Is Nothing Then Exit Sub
    
22.     Application.ScreenUpdating = False
    
23.     Application.DisplayAlerts = False
    
24.     rg.Delete
    
25.     Application.DisplayAlerts = True
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "删除完成"
    
28. End Sub
    

复制代码

跑跑2014

hwc2ycy 发表于 2014-4-13 23:52
删除承租单位与合并金额之间的所有行吧？

谢谢您的回复，见零把那个工地所有相关内容全部删除。
If arr(i, 1) = 0 And Not IsEmpty(arr(i, 1)) Then这句话就开始报错了。

hwc2ycy

跑跑2014 发表于 2014-4-14 00:25
谢谢您的回复，见零把那个工地所有相关内容全部删除。
If arr(i, 1) = 0 And Not IsEmpty(arr(i, 1))  ...

你是不是不是用一楼的附件测的呀？

hwc2ycy

是不是你的单元格里有错误值呀。

跑跑2014

hwc2ycy 发表于 2014-4-14 08:56
是不是你的单元格里有错误值呀。

With Sheet110
Dim arr, i&

    Dim rg As Range

    Dim lRow&

    arr = .Range("af1:ag" & .Cells(.Rows.Count, "af").End(xlUp).Row).Value

    For i = UBound(arr) To 2 Step -1。。。。。。。。。
。。。。。。。。。。
您说对了，我是在别的地方用的这段代码，里面的确有一个错误值。现在已经纠正过来了，是我要的效果。
还想问您下，因我是在别的工作表里运行此段代码，所以要标下哪个工作表，
Dim rg As Range这句话里，那个Range　还用在前面加个点吗。成　.Range

hwc2ycy

不用，dim rg as range里的range是指类型。