[已解决]老师帮助编写查询指定工薄数据代码

新会甜橙

在产品明细工作薄打开或关闭的状态,在查询表的C3单元格输入产品名称,或D3单元格输入产品编码,或E3单元格输入
防伪码,(这三个条件单一个查询就行了,即三种查询方式)可以查找产品明细工作薄的所有符合条件数据在查询表A6-J6显示.

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2012-12-5 14:37

1. Sub AA()
   
2. Dim CNN As Object, SQL(), SH As Worksheet, N As Integer, SQL2, nm$, mc$
   
3. Set CNN = CreateObject("ADODB.CONNECTION")
   
4. nm = ThisWorkbook.Path & "\产品明细.xls"
   
5. mc = [c3].Value: bm = [d3].Value: fm = [e3].Value
   
6. CNN.Open "PROVIDER = MICROSOFT.JET.OLEDB.4.0;EXTENDED PROPERTIES =EXCEL 8.0;DATA SOURCE =" & nm
   
7. For Each SH In Workbooks("产品明细.xls").Sheets
   
8.     N = N + 1
   
9.     ReDim Preserve SQL(1 To N)
   
10.     If mc <> "" Then
    
11.         SQL(N) = "SELECT * FROM [" & SH.Name & "$a3:j] WHERE 产品名称='" & mc & "'"
    
12.     ElseIf bm <> "" Then
    
13.         SQL(N) = "SELECT * FROM [" & SH.Name & "$a3:j] WHERE 产品编码='" & bm & "'"
    
14.     ElseIf fm <> "" Then
    
15.         SQL(N) = "SELECT * FROM [" & SH.Name & "$a3:j] WHERE 防伪码='" & fm & "'"
    
16.     End If
    
17. Next
    
18. SQL2 = Join(SQL, " UNION ALL ")
    
19. [A6:j1000].ClearContents
    
20. [A6].CopyFromRecordset CNN.Execute(SQL2)
    
21. CNN.Close
    
22. Set CNN = Nothing
    
23. End Sub
    

复制代码

跳转到最佳答案楼层

蓝桥玄霜

1. Sub AA()
   
2. Dim CNN As Object, SQL(), SH As Worksheet, N As Integer, SQL2, nm$, mc$
   
3. Set CNN = CreateObject("ADODB.CONNECTION")
   
4. nm = ThisWorkbook.Path & "\产品明细.xls"
   
5. mc = [c3].Value: bm = [d3].Value: fm = [e3].Value
   
6. CNN.Open "PROVIDER = MICROSOFT.JET.OLEDB.4.0;EXTENDED PROPERTIES =EXCEL 8.0;DATA SOURCE =" & nm
   
7. For Each SH In Workbooks("产品明细.xls").Sheets
   
8.     N = N + 1
   
9.     ReDim Preserve SQL(1 To N)
   
10.     If mc <> "" Then
    
11.         SQL(N) = "SELECT * FROM [" & SH.Name & "$a3:j] WHERE 产品名称='" & mc & "'"
    
12.     ElseIf bm <> "" Then
    
13.         SQL(N) = "SELECT * FROM [" & SH.Name & "$a3:j] WHERE 产品编码='" & bm & "'"
    
14.     ElseIf fm <> "" Then
    
15.         SQL(N) = "SELECT * FROM [" & SH.Name & "$a3:j] WHERE 防伪码='" & fm & "'"
    
16.     End If
    
17. Next
    
18. SQL2 = Join(SQL, " UNION ALL ")
    
19. [A6:j1000].ClearContents
    
20. [A6].CopyFromRecordset CNN.Execute(SQL2)
    
21. CNN.Close
    
22. Set CNN = Nothing
    
23. End Sub
    

复制代码

hwc2ycy

学习了。

zjdh

1. Sub TEST()
   
2.     Sheets("数据").Range("A2:J65536").ClearContents
   
3.     Set WK = Workbooks.Open(ThisWorkbook.Path & "\产品明细.xls")
   
4.     For Each SH In WK.Sheets
   
5.         ARR = SH.Range("A4:J" & SH.Range("A65536").End(3).Row)
   
6.         ThisWorkbook.Sheets("数据").Range("A65536").End(3)(2).Resize(UBound(ARR), 10) = ARR
   
7.     Next
   
8.     WK.Close False
   
9.     Set WK = Nothing
   
10.     Range("A6:J65536" ).ClearContents
    
11.     Sheets("数据").Columns("A:J").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A2:J3"), CopyToRange:=Range("A5:J5"), Unique:=False
    
12. End Sub

复制代码

查询.rar (27.83 KB, 下载次数: 32)

2012-12-5 15:59 上传

点击文件名下载附件

新会甜橙

蓝桥玄霜 发表于 2012-12-5 14:37

多谢老师帮助,问题解决

新会甜橙

蓝桥玄霜 发表于 2012-12-5 14:37

多谢蓝桥玄霜版主

独股求胜

蓝桥玄霜 发表于 2012-12-5 14:37

请问按日期查如何弄啊？谢谢。