ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 385|回复: 9

[求助] 批量提取多个文件、多个sheet的指定单元格内容,

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-7-2 09:40 | 显示全部楼层 |阅读模式
求助各位大神帮忙,批量提取多个文件、多个sheet的指定单元格内容,  

     1、通过在P2、R2、指定sheet名称,提取对应sheet内的数据。
     2、根据P3-P8、R3-R8的指定单元格,提取对应数据

2.批量提取同格式多个表格指定单元格数据v2(升级版2).rar

212.63 KB, 下载次数: 18

TA的精华主题

TA的得分主题

发表于 2024-7-2 10:08 | 显示全部楼层
对小屏用户十分不友好。

TA的精华主题

TA的得分主题

发表于 2024-7-2 10:23 | 显示全部楼层
Sub myFind2()
    Set fso = CreateObject("scripting.filesystemobject")
    brr = [o1].CurrentRegion
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Set fs = fso.getfolder(ThisWorkbook.Path).Files
    arr = [a1].Resize(fs.Count + 3, 13)
    r = 2
    For Each f In fs
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
            With Workbooks.Open(f)
                b1 = False
                b5 = False
                For Each sh In .Sheets
                    If sh.Name = brr(2, 2) Then
                        b1 = True
                    Else
                        If sh.Name = brr(2, 4) Then
                            b5 = True
                        End If
                    End If
                Next sh
                If b1 Or b5 Then
                    r = r + 1
                    arr(r, 1) = f.Name
                    For j = 3 To UBound(brr)
                        If b1 = True Then
                            If Len(brr(j, 2)) > 0 Then arr(r, j - 1) = .Sheets(brr(2, 2)).Range(brr(j, 2))
                        End If
                        If b5 = True Then
                            If Len(brr(j, 4)) > 0 Then arr(r, j + 5) = .Sheets(brr(2, 4)).Range(brr(j, 4))
                        End If
                    Next j
                End If
                .Close False
            End With
        End If
    Next f
    ThisWorkbook.Sheets(1).[a1].Resize(r, 13) = arr
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-7-2 10:23 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-7-2 10:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2024-7-2 10:38 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

数据处理多了,能了解一些

TA的精华主题

TA的得分主题

发表于 2024-7-2 11:17 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
为了方便处理,我擅自将文件名改成英文单子母

TQ.rar

119.07 KB, 下载次数: 18

TA的精华主题

TA的得分主题

发表于 2024-7-18 09:47 | 显示全部楼层
果然是大数据, 数据也会看出平时的生活小轨迹。

TA的精华主题

TA的得分主题

发表于 2024-7-18 09:57 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
那这个文件能提取不同文件夹里的多个文件里的单元格内容吗?

TA的精华主题

TA的得分主题

发表于 2024-8-2 12:52 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
yes_cn 发表于 2024-7-2 11:17
为了方便处理,我擅自将文件名改成英文单子母

1333333333
1555555555
这个号放了吗
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-18 08:43 , Processed in 0.049783 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表