[已解决]frankzhang21老师！请再帮我改下数据结果的存放位置！

lenovo0312

frankzhang21老师！请帮我把数据结果直接存放到ListView1中显示！谢谢！

比较复杂的筛选.rar (32.45 KB, 下载次数: 9)

2017-8-17 22:16 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-8-18 15:52

是不是这样？

1. Private Sub CommandButton1_Click()
   
2. 'arr2 = Array("编码", "产地", "货品", "规格", "方式", "日期", "单价", "听数", "金额")
   
3. 'Range("V5:AD24").ClearContents
   
4. ListView1.ListItems.Clear
   
5. arr = Sheet1.UsedRange
   
6. ReDim arr1(1 To UBound(arr), 1 To 9)
   
7. Set d = CreateObject("scripting.dictionary")
   
8. Set d1 = CreateObject("scripting.dictionary")
   
9. For x = 5 To UBound(arr)
   
10.    d1(arr(x, 20)) = d1(arr(x, 20)) + arr(x, 18)
    
11.    'If arr(X, 6) = "退" Or arr(X, 6) = "赠" Then
    
12.    d(arr(x, 20)) = ""
    
13.    'End If
    
14. Next
    
15. p = d.keys
    
16. q = d1.keys
    
17. t = d1.items
    
18. For i = 0 To d.Count - 1
    
19. For x = 5 To UBound(arr)
    
20. For j = 0 To d1.Count - 1
    
21. 'If arr(x, 20) = p(i) Then
    
22.   If arr(x, 20) = p(i) And arr(x, 21) = ComboBox1.Value Then
    
23.   If q(j) = p(i) And t(j) <> 0 Then
    
24.    k = k + 1
    
25.    With ListView1
    
26.      .ListItems.Add , , arr(x, 20)
    
27.      .ListItems(k).SubItems(1) = arr(x, 3)
    
28.      .ListItems(k).SubItems(2) = arr(x, 4)
    
29.      .ListItems(k).SubItems(3) = arr(x, 5)
    
30.      .ListItems(k).SubItems(4) = arr(x, 6)
    
31.      .ListItems(k).SubItems(5) = arr(x, 15)
    
32.      .ListItems(k).SubItems(6) = arr(x, 9)
    
33.      .ListItems(k).SubItems(7) = arr(x, 18)
    
34.      .ListItems(k).SubItems(8) = arr(x, 11)
    
35.    End With
    
36.    End If
    
37.    End If
    
38.    Next
    
39. Next
    
40. Next
    
41. End Sub

复制代码

跳转到最佳答案楼层

frankzhang21

不好意思啊，窗体控件这些不怎么会

为啥要做个窗体呢

lenovo0312

frankzhang21 发表于 2017-8-18 10:38
不好意思啊，窗体控件这些不怎么会

为啥要做个窗体呢

谢谢老师！我只是想看看
怎样修改能够达到

• 图片中说的这种效果！{:31:}
  

请《坛里》路过的《老师》帮忙实现下！?

大灰狼1976

是不是这样？

1. Private Sub CommandButton1_Click()
   
2. 'arr2 = Array("编码", "产地", "货品", "规格", "方式", "日期", "单价", "听数", "金额")
   
3. 'Range("V5:AD24").ClearContents
   
4. ListView1.ListItems.Clear
   
5. arr = Sheet1.UsedRange
   
6. ReDim arr1(1 To UBound(arr), 1 To 9)
   
7. Set d = CreateObject("scripting.dictionary")
   
8. Set d1 = CreateObject("scripting.dictionary")
   
9. For x = 5 To UBound(arr)
   
10.    d1(arr(x, 20)) = d1(arr(x, 20)) + arr(x, 18)
    
11.    'If arr(X, 6) = "退" Or arr(X, 6) = "赠" Then
    
12.    d(arr(x, 20)) = ""
    
13.    'End If
    
14. Next
    
15. p = d.keys
    
16. q = d1.keys
    
17. t = d1.items
    
18. For i = 0 To d.Count - 1
    
19. For x = 5 To UBound(arr)
    
20. For j = 0 To d1.Count - 1
    
21. 'If arr(x, 20) = p(i) Then
    
22.   If arr(x, 20) = p(i) And arr(x, 21) = ComboBox1.Value Then
    
23.   If q(j) = p(i) And t(j) <> 0 Then
    
24.    k = k + 1
    
25.    With ListView1
    
26.      .ListItems.Add , , arr(x, 20)
    
27.      .ListItems(k).SubItems(1) = arr(x, 3)
    
28.      .ListItems(k).SubItems(2) = arr(x, 4)
    
29.      .ListItems(k).SubItems(3) = arr(x, 5)
    
30.      .ListItems(k).SubItems(4) = arr(x, 6)
    
31.      .ListItems(k).SubItems(5) = arr(x, 15)
    
32.      .ListItems(k).SubItems(6) = arr(x, 9)
    
33.      .ListItems(k).SubItems(7) = arr(x, 18)
    
34.      .ListItems(k).SubItems(8) = arr(x, 11)
    
35.    End With
    
36.    End If
    
37.    End If
    
38.    Next
    
39. Next
    
40. Next
    
41. End Sub

复制代码

lenovo0312

大灰狼1976 发表于 2017-8-18 15:52
是不是这样？

老师牛~！