多条件多工作簿多工作表查询

hefuqing

  Sub 多条件多工作簿多工作表查询()
StartTime = Timer
Application.ScreenUpdating = False
Dim str$, str1$
Dim ran As Range

With ThisWorkbook.Sheets("查询")
Set ran = .Range("A5:L25000")
ran = ""
brr = .Range("A5:L25000")
crr = .Range("A2:L2")
End With

MyFile = Dir(ThisWorkbook.Path & "\分表\*.*") '取得分表文件夹下任意一个文件名
Do '循环文件夹里的文件
    Set Wb = GetObject(ThisWorkbook.Path & "\分表\" & MyFile) '在后台打开工作簿且赋值给变量Wb
        For x = 1 To Wb.Sheets.Count '循环打开的工作簿里的工作表
          If Application.CountA(Wb.Sheets(x).UsedRange) > 1 Then
              Arr = Wb.Sheets(x).[a3].CurrentRegion
                   For j = 2 To UBound(Arr)
                       For i = 1 To UBound(crr, 2)
                           If crr(1, i) <> "" Then
                               str = str & "*" & UCase（crr(1, i)） & "*"
                               str1 = str1 & Arr(j, i)
                           End If
                       Next i

                         If str1 Like str And str <> "" Then
                             mm = mm + 1
                               For m = 1 To UBound(Arr, 2)
                                  brr(mm, m) = Arr(j, m)
                                  brr(mm, 11) = MyFile
                                  brr(mm, 12) = Wb.Sheets(x).Name
                              Next m
                         End If
                             str1 = ""
                             str = ""
                Next j
          End If
      Next x
   Wb.Close True '关闭wb工作簿
MyFile = Dir '第二次赋值不要参数,且自动找到下一个工作簿
Loop While MyFile <> ""
ThisWorkbook.Sheets("查询").Columns("b:z").NumberFormat = "@"
ran = "": ran = brr
TimeOne = Format(Timer - StartTime, "0.00000") & "秒"       
Application.ScreenUpdating = True
MsgBox "查询时间：" &  TimeOne
End Sub

jiminyanyan

谢谢分享，写的简单了点。。。

sdgyc

谢谢分享！！！能上传附件更好！！！

hefuqing

jiminyanyan 发表于 2018-8-19 10:25
谢谢分享，写的简单了点。。。

复杂的是什么？

iwangyi

分享学习，同时问一下处理多工作簿时 DIR  与 SOF 脚本的异同点。

hefuqing

iwangyi 发表于 2018-8-19 10:47
分享学习，同时问一下处理多工作簿时 DIR  与 SOF 脚本的异同点。

我也是菜鸟

microyip

http://club.excelhome.net/thread-1310803-1-1.html 参考变通一下

hefuqing

microyip 发表于 2018-8-19 11:10
http://club.excelhome.net/thread-1310803-1-1.html 参考变通一下

他这个太复杂了 我这个简单

microyip

hefuqing 发表于 2018-8-19 11:15
他这个太复杂了 我这个简单

针对性的肯定会是简单啦，我可以写得比你更简单的，哈哈

hefuqing

microyip 发表于 2018-8-19 11:35
针对性的肯定会是简单啦，我可以写得比你更简单的，哈哈

那你发个更简单的啊