如果等于0保留与之单号相同的行数据

x7893930

求助大神！！！

如果E列产品金额等于0，则A列单号与之相同的都保留，否则则删除整行数据。
想了半天还是没有思路，vba小白 恳请大神指点

shiruiqiang

E列产品金额等于0，则A列单号做字典，提取字典对应的数据

不知道为什么

如图，参考。。。。。。。。。。

tel3033

供参考……

tel3033

1. Sub byDD()
   
2. Dim arr, brr(), i%, j%, n%, endRow%
   
3. Application.ScreenUpdating = False
   
4.     With Sheets("业务员毛利表")
   
5.         arr = .[a1].CurrentRegion
   
6.         n = UBound(arr, 2)
   
7.         For i = 2 To UBound(arr)
   
8.             If arr(i, 5) = 0 Then
   
9.                 endRow = endRow + 1
   
10.                 ReDim Preserve brr(1 To n, 1 To endRow)
    
11.                 For j = 1 To n
    
12.                     brr(j, endRow) = arr(i, j)
    
13.                 Next
    
14.             End If
    
15.         Next
    
16.     .[a2].Resize(UBound(arr) - 1, UBound(arr, 2)).ClearContents
    
17.     .[a2].Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
    
18.     End With
    
19. Application.ScreenUpdating = True
    
20. MsgBox "OK!"
    
21. End Sub

复制代码

sdytsxd991122

我参与

yynrzwh

1. Sub del()
   
2. 
   
3. arr = Sheets("业务员毛利表").UsedRange
   
4. Set d = CreateObject("scripting.dictionary")
   
5. 
   
6.     For i = 2 To UBound(arr)
   
7.         If arr(i, 5) = 0 Then
   
8.             d(arr(i, 1)) = i
   
9.         End If
   
10.     Next i
    
11.    
    
12.     For i = UBound(arr) To 2 Step -1
    
13.         If Not d.exists(arr(i, 1)) Then
    
14.             Rows(i).Delete
    
15.         End If
    
16.     Next i
    
17. Set d = Nothing
    
18. End Sub

复制代码

全党

Sub shishi()
Dim brr()
Set dic = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
If arr(i, 5) = 0 Then dic(arr(i, 1)) = ""
Next
For i = 2 To UBound(arr)
If dic.exists(arr(i, 1)) Then
n = n + 1
ReDim Preserve brr(1 To n)
brr(n) = Application.Index(arr, i)
End If
Next
Sheet1.UsedRange.Offset(1).ClearContents
[a2].Resize(n, UBound(arr, 2)) = Application.Rept(brr, 1)
End Sub