VBA SQL 多表查询

daya1dai

情况描述如下： 需要用四个关键词 用户名 用户地址 开始时间 结束时间 进行查询。
查询的表格在同一文件夹下 20个左右工作簿 每个工作簿5-7个工作表，每个表的数据大概在 6000条

每个工作表的四个关键字所在列数不一样，而且不相邻，我试过数组和字典，查询速度很慢，请问SQL语句应该怎么写？但是我对SQL实在不擅长，查了一下午没有方向，希望大家可以帮助我。附上自己写的用字典查询的代码。
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.xls")
nm = ThisWorkbook.Name
Set d = CreateObject("Scripting.Dictionary")
Dim targetWB(1 To 15)
    R = 1
    f = Dir(p & "*.xls")
    Do
        If Split(f, ".")(0) <> Split(nm, ".")(0) Then
        targetWB(R) = p & f
            Workbooks.Open (targetWB(R)), UpdateLinks:=0
            Set wbtarget = Workbooks.Open(targetWB(R))
            targetWB(R) = Split(wbtarget.Name, ".")(0)
            R = R + 1
        End If
    f = Dir
    Loop Until f = ""
ThisWorkbook.Sheets("汇总1").Columns("A:AZ").Delete
For tarWB = 1 To R - 1

For i = 2 To ThisWorkbook.Sheets("汇总").Range("a65536").End(xlUp).Row
                      ThisWorkbook.Sheets("汇总").Rows(i).Copy ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).Offset(1, 0)
                    ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).Interior.ColorIndex = 40



myAddress = ThisWorkbook.Sheets("汇总").Cells(i, "D")
myAddressName = ThisWorkbook.Sheets("汇总").Cells(i, "E")
myStartTime = CLng(ThisWorkbook.Sheets("汇总").Cells(i, "F"))
myEndTime = CLng(ThisWorkbook.Sheets("汇总").Cells(i, "G"))

searchlocal = Join(Array(myAddress, myAddressName, myStartTime, myEndTime), "#")


For Each sh In Workbooks(targetWB(tarWB)).Worksheets

     '   For k = Workbooks(targetWB(tarWB)).Sheets.Count To 1 Step -1 ' 搜索文件的所有sheet
          '  With Workbooks(targetWB(tarWB)).Sheets(k)
          With sh
                Set f1 = .Rows(1).Find("站点编码", LookAt:=xlWhole)
                Set f2 = .Rows(1).Find("站点名称", LookAt:=xlWhole)
                Set f3 = .Rows(1).Find("起始日期", LookAt:=xlWhole)
                Set f4 = .Rows(1).Find("截止日期", LookAt:=xlWhole)



                If f1 Is Nothing Or f2 Is Nothing Or f3 Is Nothing Or f4 Is Nothing Then
                    ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).Offset(1, 0).Resize(1, 4) = Array("△", wbtarget.Name, .Name, "表格式不符")
                Else
                    ColumnsAddress = f1.Column
                    ColumnsAddressName = f2.Column
                    ColumnsStartTime = f3.Column
                    ColumnsEndTime = f4.Column

                    ReDim arrtarget(2 To .Range("a65536").End(xlUp).Row)
                    Erase arrtarget
                    For m = 2 To .Range("a65536").End(xlUp).Row 'sheet中所有行


                        If .Cells(m, ColumnsAddress) = "" Or _
                            .Cells(m, ColumnsAddressName) = "" Or _
                            .Cells(m, ColumnsStartTime) = "" Or _
                            .Cells(m, ColumnsEndTime) = "" Then

                        Else
                        target = Array(.Cells(m, ColumnsAddress), .Cells(m, ColumnsAddressName), CLng(CDate(.Cells(m, ColumnsStartTime))), CLng(CDate(.Cells(m, ColumnsEndTime))))
                        target = Join(target, "#")
                            d(target) = m

                        End If

                        If d.exists(searchlocal) Then
                            .Rows(d.Item(searchlocal)).Copy
                            ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                            ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).PasteSpecial Paste:=xlPasteFormats


                            ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).Resize(1, 4) = Array("●", targetWB(tarWB), .Name, d.Item(searchlocal))

                            ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).Interior.ColorIndex = 3


                        Else ' 数据不符
                            ThisWorkbook.Sheets("汇总1").[A65536].End(xlUp).Resize(1, 4) = Array("×", targetWB(tarWB), .Name, "无数据")
                        End If

                    Next m
                End If
            End With
        Next


Application.CutCopyMode = False
Next i
Next tarWB

For tarWB = 1 To R

Workbooks(targetWB(tarWB)).Close
Next tarWB

Application.ScreenUpdating = True
MsgBox "finished"
End Sub

lilyhcn1

上传个附件吧，我的通用查询应该能帮助你。

daya1dai

lilyhcn1 发表于 2019-1-22 19:15
上传个附件吧，我的通用查询应该能帮助你。

稍等 正在整理

daya1dai

附件，请大家帮忙修改一下

daya1dai

daya1dai 发表于 2019-1-22 19:43
稍等 正在整理

附件添加到楼下了 谢谢

chentonny

你的代码全是在访问对象，肯定慢。

daya1dai

chentonny 发表于 2019-1-22 21:18
你的代码全是在访问对象，肯定慢。

不访问对象怎么改进？是用SQL吗？

chentonny

daya1dai 发表于 2019-1-22 21:24
不访问对象怎么改进？是用SQL吗？

如果你非要用EXCEL处理这些数据，建议还是用EXCEL做前台，ACCESS做后台，通过ADO连结。