VBA关于多工作簿查询包含指定的字符的应用（很难的）

ww0000

kevinchengcw 发表于 2010-11-4 13:18
1.这句的函数什么意思？怎么使用？
InStrRev(Wb.Name, ".") - 1
答：获取工作簿名最后一个句号的位置值， ...

能不能再加上个条件判断呀？

工作状态

kevinchengcw 发表于 2012-8-25 10:09
试下附件

kevinchengcw老师好
这个附件中，能够将默认的本地工作簿路径，修改为：可以自由选定指定文件夹目录下的指定文件，然后再进行数据的提取吗
12年的时候您曾经帮忙解决过本地工作簿路径数据提取的问题，非常实用，非常感谢！

工作状态

工作状态 发表于 2016-12-5 17:14
kevinchengcw老师好
这个附件中，能够将默认的本地工作簿路径，修改为：可以自由选定指定文件夹目录下的 ...

就是那种先打开对话框然后一层层点击进去选择一个或多个目标文件，然后再进行数据的查询提取，参考了论坛的很多VBA代码来修改附件中的代码，还是不会，请老师帮忙一下，多谢！

工作状态

kevinchengcw 发表于 2012-8-25 10:09
试下附件

就是在这个附件上想实现上面的效果，参考了很多VBA代码都没搞明白，请老师帮忙^_^

sjl_fyl

收藏学习了~

marychin1981

学习了，谢谢了，继续跟踪

ykcbf1100

参与一下。

以为真的很难，其实难度一般了。

ykcbf1100

代码供参考。。。

1. Sub ykcbf()  '//2024.3.11
   
2.     Set Fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Dim tm: tm = Timer
   
5.     Set sh = ThisWorkbook.Sheets("查询")
   
6.     p = ThisWorkbook.Path & ""
   
7.     ReDim brr(1 To 1000, 1 To 6)
   
8.     st = Application.InputBox("请输入要查询的字符串：", "字串输入", "防盗锁")
   
9.     If st = Empty Then Exit Sub
   
10.     On Error Resume Next
    
11.     For Each f In Fso.GetFolder(p).Files
    
12.         If f.Name Like "*.xls*" Then
    
13.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
14.                 Set wb = Workbooks.Open(f, 0)
    
15.                 For Each sht In wb.Sheets
    
16.                     If IsArray(sht.UsedRange) Then
    
17.                         With sht
    
18.                             Set Rng = .UsedRange.Find(st)
    
19.                             If Not Rng Is Nothing Then
    
20.                                 m = m + 1
    
21.                                 brr(m, 1) = m
    
22.                                 brr(m, 2) = Fso.GetBaseName(f)
    
23.                                 brr(m, 3) = .Name
    
24.                                 brr(m, 4) = Replace(Rng.Address, "$", "")
    
25.                                 brr(m, 5) = Rng.Value
    
26.                             End If
    
27.                         End With
    
28.                     End If
    
29.                 Next
    
30.                 wb.Close 0
    
31.             End If
    
32.         End If
    
33.     Next f
    
34.     With sh
    
35.         .UsedRange.Offset(2).Clear
    
36.         .[a2].Resize(1, 6).Interior.Color = 49407
    
37.         .[e3].Resize(m, 1).Interior.Color = 5296274
    
38.         With .[a3].Resize(m, 6)
    
39.             .Value = brr
    
40.             .Borders.LineStyle = 1
    
41.             .HorizontalAlignment = xlCenter
    
42.             .VerticalAlignment = xlCenter
    
43.             .EntireColumn.AutoFit
    
44.         End With
    
45.     End With
    
46.     Application.ScreenUpdating = True
    
47.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
48. End Sub
    

复制代码

jjmysjg

这个需要在一个