ado筛选怎么写ComboBox有请zhaogang1960老师

zhaogang1960

原帖由 chengang1982 于 2011-3-21 21:39 发表
第一次见这种写法arr = [a2:h2&""]太高了请问侠圣gang1960  
如果写成Range或Cells----应该怎么写呢，怎么表示呢

没有对应的写法，可以用Transpose函数转换两次
    arr = Range("A2:H2")
    arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))

西北风扬

谢谢侠圣解答学习，这样arr = [a2:h2&""]，好像不能指定工作表

abc123qqq

学习了

chengang1982

学习了谢谢

zhaogang1960

请看附件
求助.rar (17.23 KB, 下载次数: 15)

2012-6-28 10:53 上传

点击文件名下载附件

zhaogang1960

myyj821001 发表于 2012-6-24 11:10
赵老师,把你做好符件传个上来学习学习

1楼附件，8楼代码：
新建文件夹 (2).rar (19.17 KB, 下载次数: 14)

2012-6-24 11:35 上传

点击文件名下载附件

myyj821001

赵老师,把你做好符件传个上来学习学习

zhaogang1960

myyj821001 发表于 2012-6-28 09:26
太感谢你了赵老师,强大,我就是想要这个功能,这一课对我受益非浅,我一定好好学习,总结总结再总结,真诚的向 ...

1. Private Sub CommandButton1_Click()
   
2.     Dim cnn As Object, rs As Object, SQL$, s$, lr&
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     Set rs = CreateObject("ADODB.Recordset")
   
5.     If ComboBox3 <> "" Then s = " and [" & ComboBox1 & "] like '" & ComboBox3 & "'"
   
6.     If ComboBox4 <> "" Then s = s & " and [" & ComboBox2 & "] like '" & ComboBox4 & "'"
   
7.     Application.ScreenUpdating = False
   
8.     lr = Range("A4").CurrentRegion.Row + Range("A4").CurrentRegion.Rows.Count
   
9.     Cells(lr, 1).Resize(lr, 21).ClearContents
   
10.     Cells.EntireRow.Hidden = False
    
11.     If s = "" Then Exit Sub
    
12.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties =Excel 8.0;Data Source =" & ThisWorkbook.FullName
    
13.     SQL = "Select * from [Sheet1$" & Range("A4").CurrentRegion.Address(0, 0) & "] where " & Mid(s, 5)
    
14.     rs.Open SQL, cnn, 1, 3
    
15.     If rs.RecordCount Then
    
16.         Cells(5, 1).Resize(lr - 4).EntireRow.Hidden = True
    
17.         Cells(lr + 1, 1).CopyFromRecordset rs
    
18.     End If
    
19.     cnn.Close
    
20.     Set cnn = Nothing
    
21.     Application.ScreenUpdating = True
    
22. End Sub
    
23. Private Sub CommandButton2_Click()
    
24.     Dim lr&
    
25.     lr = Range("A4").CurrentRegion.Row + Range("A4").CurrentRegion.Rows.Count
    
26.     Cells(lr, 1).Resize(lr, 21).ClearContents
    
27.     Cells.EntireRow.Hidden = False
    
28.     Unload Me
    
29. End Sub
    

复制代码

myyj821001

zhaogang1960 发表于 2012-6-24 11:35
1楼附件，8楼代码：

太强了,我的是在数据表里,也就想用这么个窗体筛选数据,初学,对数据库还不懂
我想使用VBA窗体来实现数据的筛选,(窗体和按我已经做好了,在附件中)

1.使combobox1和combobox2引用字段名(即:编号,姓名性别~~~~~~~在职状态这一行的数据) 最好是Combobox1选择的,在combobox2中不在出现

2.使combobox3根据combobox1输选择的字段名引用其字段下的内容,combobox4根据combobox2选择的字段名引用其字段下的数据,其引用的数据在列表中没有空白和重复内容

3.根据combobox1~4选择的内容对数据表"sheet1"的内容进行筛选,(可以只输入combobox1和3,也可以4个一起选择进行多条件筛选)

4.点击窗体上的"取消退出"按钮后,实现"全部显示",将筛选后的隐藏数据全部显示出来
求助.rar (10.46 KB, 下载次数: 4)

2012-6-27 16:31 上传

点击文件名下载附件

老师请你帮帮我,我已经在贴子里多方求助,可能是因为问题太多,还是因为太简单,一直没得到解决.拜托你了

zhaogang1960

myyj821001 发表于 2012-6-27 16:35
太强了,我的是在数据表里,也就想用这么个窗体筛选数据,初学,对数据库还不懂
我想使用VBA窗体来实现数据的 ...

有点复杂，请测试

1. Dim arr
   
2. 
   
3. Private Sub ComboBox1_Change()
   
4.     If ComboBox1.ListIndex = -1 Then Exit Sub
   
5.     Dim i&, m&, brr(), d As Object
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     ReDim brr(1 To UBound(arr, 2))
   
8.     For i = 1 To UBound(arr, 2)
   
9.         If arr(1, i) <> ComboBox1.Value Then
   
10.             m = m + 1
    
11.             brr(m) = arr(1, i)
    
12.         End If
    
13.     Next
    
14.     ComboBox2.List = brr
    
15.     m = ComboBox1.ListIndex + 1
    
16.     For i = 2 To UBound(arr)
    
17.         d(arr(i, m)) = ""
    
18.     Next
    
19.     ComboBox3.Clear
    
20.     ComboBox3.List = WorksheetFunction.Transpose(d.keys)
    
21. End Sub
    
22. 
    
23. 
    
24. Private Sub ComboBox2_Change()
    
25.     If ComboBox2.ListIndex = -1 Then Exit Sub
    
26.     Dim i&, m&, d As Object
    
27.     Set d = CreateObject("scripting.dictionary")
    
28.     m = Sheets("Sheet1").Rows(4).Find(ComboBox2.Value, , , 1).Column
    
29.     For i = 2 To UBound(arr)
    
30.         d(arr(i, m)) = ""
    
31.     Next
    
32.     ComboBox4.Clear
    
33.     ComboBox4.List = WorksheetFunction.Transpose(d.keys)
    
34. End Sub
    
35. 
    
36. 
    
37. Private Sub CommandButton1_Click()
    
38.     Dim cnn As Object, SQL$, s$
    
39.     Set cnn = CreateObject("ADODB.Connection")
    
40.     If ComboBox3 <> "" Then s = " and [" & ComboBox1 & "] like '" & ComboBox3 & "'"
    
41.     If ComboBox4 <> "" Then s = s & " and [" & ComboBox2 & "] like '" & ComboBox4 & "'"
    
42.     If s = "" Then Exit Sub
    
43.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties =Excel 8.0;Data Source =" & ThisWorkbook.FullName
    
44.     SQL = "Select * from [Sheet1$A4:U] where " & Mid(s, 5)
    
45.     With Sheets("Sheet2")
    
46.         .UsedRange.Offset(1).ClearContents
    
47.         .[a2].CopyFromRecordset cnn.Execute(SQL)
    
48.         .Activate
    
49.     End With
    
50.     cnn.Close
    
51.     Set cnn = Nothing
    
52. End Sub
    
53. 
    
54. Private Sub CommandButton2_Click()
    
55.     Unload Me
    
56. End Sub
    
57. 
    
58. Private Sub UserForm_Initialize()
    
59.     ComboBox1.List = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Sheets("Sheet1").Range("A4:U4").Value))
    
60.     arr = Sheets("Sheet1").Range("A4:U" & Sheets("Sheet1").Range("A65536").End(xlUp).Row)
    
61. End Sub
    

复制代码