批量提取多个Excel文件内指定单元格的数据（文件名和数据）

最新推荐文章于 2024-07-30 15:40:41 发布

ynrainy

最新推荐文章于 2024-07-30 15:40:41 发布

阅读量2.2w

点赞数 11

分类专栏： Office与OA

本文链接：https://blog.youkuaiyun.com/tommycsdn/article/details/106500359

版权

Office与OA 专栏收录该内容

7 篇文章

订阅专栏

通过VBA宏代码批量读取多个Excel文件中特定单元格的数据，包括文件名和数据，自动汇总到新的Excel文件中，适用于收集和整理统一格式的个人简历等信息。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

批量提取多个Excel文件内指定单元格的数据（文件名和数据）

例如收集了excel表格统一格式的个人简历，从中抽取个人基本信息，生成数据表。
将源数据excel文件放在同一个文件夹下。
新建一个shouji.xls也放在该文件夹下。

原表格数据
1.xls
---------------
A B
3 60 101
---------------
2.xls
3.xls

打开shouji.xls，按住Alt+F11进入宏界面，点击菜单的插入->模块，在代码窗口粘贴如下代码：
VBA代码如下：
-----------------------------
Sub find()
Application.ScreenUpdating = False
Dim Mydir As String
Dim i As Integer
i = 2
Mydir = ThisWorkbook.Path & "\"
ChDrive Left(Mydir, 1)
ChDir Mydir
Match = Dir$("*.xls")
Do
If Not LCase(Match) = LCase(ThisWorkbook.Name) Then
Workbooks.Open Match, 0, 1
ThisWorkbook.ActiveSheet.Range("A" & i) = Match
ThisWorkbook.ActiveSheet.Range("B" & i) = ActiveWorkbook.Sheets("Sheet1").Range("A3")
ThisWorkbook.ActiveSheet.Range("C" & i) = ActiveWorkbook.Sheets("Sheet1").Range("B3")
ActiveWorkbook.Close 0
i = i + 1
End If
Match = Dir$
Loop Until Len(Match) = 0
Application.ScreenUpdating = True
End Sub
----------------------------------------------
F5运行宏
在shouji.xls表格自动生成数据，如下：
A B C
2   1.xls   60   101
3   2.xls   70   130
4   3.xls   80   100

-----------------------------------
如果需要采集A3、B3的其他单元格数据，可以继续添加代码：
ThisWorkbook.ActiveSheet.Range("X" & i) = ActiveWorkbook.Sheets("Sheet1").Range("X3")
如果原数据表的单元格和目标单元格有规律，可以用循环语句解决。