[已解决]相当复杂的筛选，请老师帮我实现他!!!!

lenovo0312

相当复杂的筛选，请老师帮我实现他
重发附件，之前错误的已删除
比较复杂的筛选Book1.rar (15.9 KB, 下载次数: 16)

2012-10-29 13:27 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

huoxieshen

2012-10-29 14:40

lenovo0312 发表于 2012-10-29 13:48
自己顶一下················

继续整理下：

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

复制代码

跳转到最佳答案楼层

huoxieshen

HP0003为什么只有 赠，而不筛选 销的数据？？

lenovo0312

huoxieshen 发表于 2012-10-29 12:50
HP0003为什么只有 赠，而不筛选 销的数据？？

不好意思，附件中的效果有错误，编码我写错了。
每1个编码只对应1个货品，而这个货品的编码应该是hp0007才对！！！

北

丁

200

赠

400

4000

2012-9-19

10

HP0003

lenovo0312

自己顶一下················

huoxieshen

lenovo0312 发表于 2012-10-29 13:48
自己顶一下················

1. Sub text()
   
2.   Dim arr(), i As Long, r As Long, d As Object, g(), k As Long, arr1(1 To 60000, 1 To 9)
   
3.   With Sheet1
   
4.      r = .Cells(Rows.Count, 3).End(3).Row
   
5.      arr = Range("c5:t" & r).Value
   
6.   End With
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   For i = 1 To r - 4
   
9.       If arr(i, 4) = "退" Or arr(i, 4) = "赠" Then
   
10.          d(arr(i, 18)) = ""
    
11.       End If
    
12.   Next
    
13.   g = d.keys
    
14.   For i = 1 To r - 4
    
15.       For j = 1 To d.Count
    
16.         If arr(i, 18) = g(j - 1) Then
    
17.            k = k + 1
    
18.            arr1(k, 1) = arr(i, 18)
    
19.            arr1(k, 2) = arr(i, 1)
    
20.            arr1(k, 3) = arr(i, 2)
    
21.            arr1(k, 4) = arr(i, 3)
    
22.            arr1(k, 5) = arr(i, 13)
    
23.            arr1(k, 6) = arr(i, 4)
    
24.            arr1(k, 7) = arr(i, 7)
    
25.            arr1(k, 8) = arr(i, 16)
    
26.            arr1(k, 9) = arr(i, 9)
    
27.         End If
    
28.         
    
29.       Next
    
30.   Next
    
31. Range("V5:AD65536").ClearContents
    
32. Range("V5").Resize(k, 9) = arr1
    
33. End Sub

复制代码

看看这样可以不~~~有点复杂

huoxieshen

lenovo0312 发表于 2012-10-29 13:48
自己顶一下················

继续整理下：

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

复制代码

lenovo0312

huoxieshen 发表于 2012-10-29 14:40
继续整理下：

老师，请抽空帮我再加个判断好吗？
http://www.excelpx.com/thread-288799-1-1.html