按筛选要求显示结果

djdjh

各位大神好，新人，有个筛选显示的效果一直无法实现。借此请教大家，详情想见附件，谢谢。

lsc900707

没有看到附件。

djdjh

谢谢版主大大提醒，上传不了，是浏览器的问题吗？

djdjh

好像上传完要选择使用。是这个附件了。

LMY123

djdjh 发表于 2018-6-27 08:58
好像上传完要选择使用。是这个附件了。

1. Sub 数组法()
   
2.     arr = Sheet1.[a1].CurrentRegion
   
3.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
4.     For r = 1 To UBound(arr)
   
5.         If arr(r, 2) <> 0 Then
   
6.         k = k + 1
   
7.         For c = 1 To UBound(arr, 2)
   
8.             brr(k, c) = arr(r, c)
   
9.         Next
   
10.         End If
    
11.     Next
    
12.     Sheet2.[a1].Resize(k, UBound(brr, 2)) = brr
    
13. End Sub
    
14. Sub ADO()
    
15.     Dim Conn As Object, Rst As Object
    
16.     Dim strConn As String, strSQL As String
    
17.     Dim i As Integer, PathStr As String
    
18.     Set Conn = CreateObject("ADODB.Connection")
    
19.     Set Rst = CreateObject("ADODB.Recordset")
    
20.     PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
    
21.     Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
    
22.     Case Is <= 11
    
23.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
24.     Case Is >= 12
    
25.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
26.     End Select
    
27.     '设置SQL查询语句
    
28.     strSQL = "SELECT * FROM [Sheet1$A:B] WHERE 数量<>0"
    
29.     Conn.Open strConn    '打开数据库链接
    
30.     Set Rst = Conn.Execute(strSQL)    '执行查询，并将结果输出到记录集对象
    
31.     With Sheet3
    
32.         .Cells.Clear
    
33.         For i = 0 To Rst.Fields.Count - 1    '填写标题
    
34.             .Cells(1, i + 1) = Rst.Fields(i).Name
    
35.         Next i
    
36.         .Range("A2").CopyFromRecordset Rst
    
37.         .Cells.EntireColumn.AutoFit  '自动调整列宽
    
38.         .Cells.EntireColumn.AutoFit  '自动调整列宽
    
39.     End With
    
40.     Rst.Close    '关闭数据库连接
    
41.     Conn.Close
    
42.     Set Conn = Nothing
    
43.     Set Rst = Nothing
    
44. End Sub

复制代码

LMY123

djdjh 发表于 2018-6-27 08:58
好像上传完要选择使用。是这个附件了。

按筛选要求显示结果.rar (19.69 KB, 下载次数: 5)

2018-6-27 10:09 上传

点击文件名下载附件

djdjh

LMY123 发表于 2018-6-27 10:09

谢谢大神，ADO的方法完全看不懂。用的SQL方法，那是新世界啊。再一次感谢！