通过VBA怎么删除值都为0的行

mssjran1

例如附件中标黄的部分都为0，则删除整行

mssjran1

求老师帮忙~

vbee

1. Sub vbee()
   
2. 
   
3. For i = 214 To 2 Step -1
   
4. arr = Cells(i, 4).Resize(, 16).Value
   
5. b = 1
   
6. For j = 1 To 16
   
7.   If arr(1, j) <> 0 Then b = 0
   
8. Next j
   
9. If b Then Rows(i).Delete Shift:=xlUp
   
10. Next i
    
11. 
    
12. End Sub
    

复制代码

mssjran1

vbee 发表于 2018-8-8 17:55

谢谢老师！

iwangyi

Sub A()
For Each RNG In Range("D2:D" & [D65536].End(3).Row)
x = Application.Sum(RNG.Resize(, 16))
If Application.Sum(RNG.Resize(, 16)) = 0 Then
Rows(RNG.Row).Delete Shift:=xlUp
End If
Next
End Sub

iwangyi

简化后：
Sub A()
For Each RNG In Range("D2:D" & [D65536].End(3).Row)
If Application.Sum(RNG.Resize(, 16)) = 0 Then Rows(RNG.Row).Delete Shift:=xlUp
Next
End Sub

iwangyi

附件************

ggmmlol

iwangyi 发表于 2018-8-8 18:45
简化后：
Sub A()
For Each RNG In Range("D2:D" & [D65536].End(3).Row)

各项的和值等于0，并不能充分保证每一项都等于0。因此要尽量避免这种取巧的办法。

1. Sub test()
   
2. r = Cells(Rows.Count, 2).End(xlUp).Row
   
3. With Range("B2:S" & r)
   
4.     ar = .Value
   
5.     c = UBound(ar, 2)
   
6.     .ClearContents
   
7. End With
   
8. For i = 1 To r - 1
   
9.     For j = 3 To c
   
10.         If ar(i, j) <> 0 Then
    
11.             n = n + 1
    
12.             For k = 1 To c
    
13.                 ar(n, k) = ar(i, k)
    
14.             Next
    
15.             Exit For
    
16.         End If
    
17.     Next
    
18. Next
    
19. [b2].Resize(n, c) = ar
    
20. End Sub

复制代码

iwangyi

ggmmlol 发表于 2018-8-9 08:07
各项的和值等于0，并不能充分保证每一项都等于0。因此要尽量避免这种取巧的办法。

说得有道理。

mssjran1

ggmmlol 发表于 2018-8-9 08:07
各项的和值等于0，并不能充分保证每一项都等于0。因此要尽量避免这种取巧的办法。

非常感谢~！