[已解决]请huoxieshen老师帮忙再加个东东！！！

lenovo0312

请老师帮忙加个判断
（根据编码,、销、退、单价)都一致，且无（赠）或的情况下，
删除多余数据(如单价有多次不同请保留别被删除)

比较复杂的筛选Book1.rar (16.27 KB, 下载次数: 11)

2012-10-29 16:39 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

huoxieshen

2012-10-29 19:48

1. 
   
2. <P>Sub text2()
   
3.   Dim arr(), i As Long, r As Long, d As Object, g(), k As Long, arr1(1 To 60000, 1 To 9)
   
4.   With Sheet1
   
5.      r = .Cells(Rows.Count, 3).End(3).Row
   
6.      arr = Range("c5:t" & r).Value
   
7.   End With
   
8.   Set d = CreateObject("scripting.dictionary")
   
9.   Set d1 = CreateObject("scripting.dictionary")
   
10.   For i = 1 To r - 4
    
11.       If d1.exists(arr(i, 18)) Then
    
12.          d1(arr(i, 18)) = d1(arr(i, 18)) + arr(i, 9)
    
13.       Else
    
14.          d1(arr(i, 18)) = arr(i, 9)
    
15.       End If
    
16.       If arr(i, 4) = "退" Or arr(i, 4) = "赠" Then
    
17.          d(arr(i, 18)) = ""
    
18.       End If
    
19.   Next
    
20.   g = d.keys
    
21.   x = d1.items
    
22.   For i = 1 To r - 4
    
23.       For j = 1 To d.Count
    
24.         If arr(i, 18) = g(j - 1) And d1(arr(i, 18)) <> 0 Then
    
25.            k = k + 1
    
26.            arr1(k, 1) = arr(i, 18)
    
27.            arr1(k, 2) = arr(i, 1)
    
28.            arr1(k, 3) = arr(i, 2)
    
29.            arr1(k, 4) = arr(i, 3)
    
30.            arr1(k, 5) = arr(i, 4)
    
31.            arr1(k, 6) = arr(i, 13)
    
32.            arr1(k, 7) = arr(i, 7)
    
33.            arr1(k, 8) = arr(i, 16)
    
34.            arr1(k, 9) = arr(i, 9)
    
35.         End If
    
36.       Next
    
37.   Next
    
38. Range("V5:AD65536").ClearContents
    
39. Range("V5").Resize(k, 9) = arr1
    
40. Range("v5:ad" & k).Sort Key1:=Range("V5"), Key2:=Range("Z5"), Order2:=xlDescending
    
41. End Sub
    
42. </P>

复制代码

试试这个吧~~~

跳转到最佳答案楼层

huoxieshen

不太明白你想要的结果，什么叫多次的请保留？？

huoxieshen

1. 
   
2. <P>Sub text2()
   
3.   Dim arr(), i As Long, r As Long, d As Object, g(), k As Long, arr1(1 To 60000, 1 To 9)
   
4.   With Sheet1
   
5.      r = .Cells(Rows.Count, 3).End(3).Row
   
6.      arr = Range("c5:t" & r).Value
   
7.   End With
   
8.   Set d = CreateObject("scripting.dictionary")
   
9.   Set d1 = CreateObject("scripting.dictionary")
   
10.   For i = 1 To r - 4
    
11.       If d1.exists(arr(i, 18)) Then
    
12.          d1(arr(i, 18)) = d1(arr(i, 18)) + arr(i, 9)
    
13.       Else
    
14.          d1(arr(i, 18)) = arr(i, 9)
    
15.       End If
    
16.       If arr(i, 4) = "退" Or arr(i, 4) = "赠" Then
    
17.          d(arr(i, 18)) = ""
    
18.       End If
    
19.   Next
    
20.   g = d.keys
    
21.   x = d1.items
    
22.   For i = 1 To r - 4
    
23.       For j = 1 To d.Count
    
24.         If arr(i, 18) = g(j - 1) And d1(arr(i, 18)) <> 0 Then
    
25.            k = k + 1
    
26.            arr1(k, 1) = arr(i, 18)
    
27.            arr1(k, 2) = arr(i, 1)
    
28.            arr1(k, 3) = arr(i, 2)
    
29.            arr1(k, 4) = arr(i, 3)
    
30.            arr1(k, 5) = arr(i, 4)
    
31.            arr1(k, 6) = arr(i, 13)
    
32.            arr1(k, 7) = arr(i, 7)
    
33.            arr1(k, 8) = arr(i, 16)
    
34.            arr1(k, 9) = arr(i, 9)
    
35.         End If
    
36.       Next
    
37.   Next
    
38. Range("V5:AD65536").ClearContents
    
39. Range("V5").Resize(k, 9) = arr1
    
40. Range("v5:ad" & k).Sort Key1:=Range("V5"), Key2:=Range("Z5"), Order2:=xlDescending
    
41. End Sub
    
42. </P>

复制代码

试试这个吧~~~

lenovo0312

huoxieshen 发表于 2012-10-29 19:48
试试这个吧~~~

谢谢老师，太感谢你了，终于知道怎么弄了···

老师真是个好人，谢谢！！！