[已解决]想加上一个筛选，求大师帮忙加上

666666666

Private Sub ComboBox1_Change()
Dim r&, i&, dic, ar, k
    Set dic = CreateObject("scripting.dictionary")
   
     ar = Sheet1.Range("D8:D" & Sheet1.[D65536].End(xlUp).Row)
    If InStr(Cells(ar, 4) & " ", ComboBox1.Text) Then
     
    For r = 1 To UBound(ar, 1)
        dic(ar(r, 1)) = ""
    Next
    k = dic.Keys
   
     
     For i = 1 To dic.Count
        With ListView1.ListItems.Add()
            .Text = Application.WorksheetFunction.Text(i, "000")
            .SubItems(1) = k(i - 1)
        End With
    Next

   Set dic = Nothing
    End If
End Sub



汇总2.rar (12.02 KB, 下载次数: 10)

2016-3-24 22:17 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

josonxu

2016-3-26 23:08

猜你 是要这个  之前不是给你写了   去重排列嘛  自己修改下不就好了

1. Private Sub ComboBox1_Change()
   
2.     Dim r&, i&, dic, ar, k
   
3.     ListView1.ListItems.Clear
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     ar = Sheet1.Range("D8:D" & Sheet1.[D65536].End(xlUp).Row)
   
6.     For r = 1 To UBound(ar, 1)
   
7.         dic(ar(r, 1)) = ""
   
8.     Next
   
9.     k = dic.Keys
   
10.     For i = 1 To dic.Count
    
11.         If k(i - 1) = ComboBox1.Value Then
    
12.             With ListView1.ListItems.Add()
    
13.                 .Text = Application.WorksheetFunction.Text(i, "000")
    
14.                 .SubItems(1) = k(i - 1)
    
15.             End With
    
16.         End If
    
17.     Next
    
18.     Set dic = Nothing
    
19. End Sub
    
20. Private Sub UserForm_Initialize()
    
21.     With UserForm1.ListView1
    
22.         .LabelEdit = lvwManual
    
23.         .HideSelection = False
    
24.         .Appearance = cc3D
    
25.         .MultiSelect = True
    
26.         .Gridlines = True
    
27.         .View = lvwReport
    
28.         .FullRowSelect = True
    
29.         .ColumnHeaders.Add , , "序号", 30
    
30.         .ColumnHeaders.Add , , "项目①", 50, lvwColumnCenter
    
31.     End With
    
32. End Sub
    

复制代码

汇总2.zip (17.16 KB, 下载次数: 8)

2016-3-26 23:10 上传

点击文件名下载附件

跳转到最佳答案楼层

爱疯

建议详细具体的说明需求。

666666666

已更新要求

josonxu

显示成什么样啊  ，之前不是给你写过   

josonxu

猜你 是要这个  之前不是给你写了   去重排列嘛  自己修改下不就好了

1. Private Sub ComboBox1_Change()
   
2.     Dim r&, i&, dic, ar, k
   
3.     ListView1.ListItems.Clear
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     ar = Sheet1.Range("D8:D" & Sheet1.[D65536].End(xlUp).Row)
   
6.     For r = 1 To UBound(ar, 1)
   
7.         dic(ar(r, 1)) = ""
   
8.     Next
   
9.     k = dic.Keys
   
10.     For i = 1 To dic.Count
    
11.         If k(i - 1) = ComboBox1.Value Then
    
12.             With ListView1.ListItems.Add()
    
13.                 .Text = Application.WorksheetFunction.Text(i, "000")
    
14.                 .SubItems(1) = k(i - 1)
    
15.             End With
    
16.         End If
    
17.     Next
    
18.     Set dic = Nothing
    
19. End Sub
    
20. Private Sub UserForm_Initialize()
    
21.     With UserForm1.ListView1
    
22.         .LabelEdit = lvwManual
    
23.         .HideSelection = False
    
24.         .Appearance = cc3D
    
25.         .MultiSelect = True
    
26.         .Gridlines = True
    
27.         .View = lvwReport
    
28.         .FullRowSelect = True
    
29.         .ColumnHeaders.Add , , "序号", 30
    
30.         .ColumnHeaders.Add , , "项目①", 50, lvwColumnCenter
    
31.     End With
    
32. End Sub
    

复制代码

汇总2.zip (17.16 KB, 下载次数: 8)

2016-3-26 23:10 上传

点击文件名下载附件

josonxu