[已解决]求老师帮忙，关于跨表搜索所有工作表的问题，已解决

zhujin8888

详情见附件

rVfFMSMr.rar (88.18 KB, 下载次数: 7)

2010-4-6 12:40 上传

点击文件名下载附件
求老师帮忙，关于跨表搜索所有工作表的问题

[此贴子已经被作者于2010-4-7 0:02:15编辑过]

最佳答案

月排行榜 / 总排行榜

amulee

2010-4-6 13:29

Sub 良率查询()
    Dim sh As String
    Dim sql$
    Dim N As Byte
    Const nm = "产品良率查询"
   
    Application.ScreenUpdating = False
    Range("a4:aa65536").ClearContents
    sh = Dir(ThisWorkbook.Path & "\sqldata\*.xls")
    While Not Len(sh) = 0
    N = 1
        With CreateObject("ADODB.CONNECTION")
            .Provider = "microsoft.jet.oledb.4.0"
            .ConnectionString = "Extended Properties='Excel 8.0;hdr=yes';" & "data source=" & ThisWorkbook.Path & "\sqldata\" & sh
            .Open
            sql = "select * from [Sheet" & N & "$a1:aa65536] where 订单号=" & [b1].Value
            [a65536].End(xlUp).Offset(1).CopyFromRecordset .Execute(sql)
            .Close
        End With
     sh = Dir()
     Wend
     Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

amulee

Sub 良率查询()
    Dim sh As String
    Dim sql$
    Dim N As Byte
    Const nm = "产品良率查询"
   
    Application.ScreenUpdating = False
    Range("a4:aa65536").ClearContents
    sh = Dir(ThisWorkbook.Path & "\sqldata\*.xls")
    While Not Len(sh) = 0
    N = 1
        With CreateObject("ADODB.CONNECTION")
            .Provider = "microsoft.jet.oledb.4.0"
            .ConnectionString = "Extended Properties='Excel 8.0;hdr=yes';" & "data source=" & ThisWorkbook.Path & "\sqldata\" & sh
            .Open
            sql = "select * from [Sheet" & N & "$a1:aa65536] where 订单号=" & [b1].Value
            [a65536].End(xlUp).Offset(1).CopyFromRecordset .Execute(sql)
            .Close
        End With
     sh = Dir()
     Wend
     Application.ScreenUpdating = True
End Sub

zhujin8888

谢谢老师，还有一个问题就是我要的搜索关键词是 产品名称 就是F列的内容，应该改哪里？谢谢

amulee

Sub 良率查询()
    Dim sh As String
    Dim sql$
    Dim N As Byte
    Const nm = "产品良率查询"
   
    Application.ScreenUpdating = False
    Range("a4:aa65536").ClearContents
    sh = Dir(ThisWorkbook.Path & "\sqldata\*.xls")
    While Not Len(sh) = 0
    N = 1
        With CreateObject("ADODB.CONNECTION")
            .Provider = "microsoft.jet.oledb.4.0"
            .ConnectionString = "Extended Properties='Excel 8.0;hdr=yes';" & "data source=" & ThisWorkbook.Path & "\sqldata\" & sh
            .Open
            sql = "select * from [Sheet" & N & "$a1:aa65536] where 产品名称=" & [b1].Value
            [a65536].End(xlUp).Offset(1).CopyFromRecordset .Execute(sql)
            .Close
        End With
     sh = Dir()
     Wend
     Application.ScreenUpdating = True
End Sub

zhujin8888

非常感谢，已解决

zsd5237

学习[em02][em02]