用VBA将多个Excel文件里的数据汇总到一个Excel表

最新推荐文章于 2025-06-13 09:44:29 发布

mzlogin

最新推荐文章于 2025-06-13 09:44:29 发布

阅读量2.7w

点赞数 11

CC 4.0 BY-SA版权

分类专栏： OFFICE/VBA 文章标签： excel vba integer string 工作生活

本文链接：https://blog.csdn.net/mzlogin/article/details/6445933

OFFICE/VBA 专栏收录该内容

4 篇文章

订阅专栏

本文介绍了一种使用VBA宏编程的方式，自动批量合并指定文件夹内多个Excel文件中的数据到一个汇总表中。该方法通过遍历指定路径下的所有Excel文件，逐个打开并读取关键字段的数据，然后按照预设的格式写入到汇总表中。

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

现要求:给出一个空汇总表,给出若干单独的Excel文件,每个文件里头有一个表格里存有一个人的信息,要将这些文件里的信息全部对应地导入到汇总表里.

以前写的,也不给实际例子了,直接上代码,逻辑不复杂,看看就明白.记在这里备以后查.

Sub ExportMyFile() Dim myPath, myFileName Dim myCurOpenWB As Workbook 'work工作簿 Dim myCurOpenWS As Worksheet 'work工作表 Dim myTotalWS As Worksheet '汇总工作表 Dim myFolderName As String myFolderName = "六堰" Set myTotalWS = ThisWorkbook.Sheets("附件4") '汇总到表名为附件4的表格里 myPath = ThisWorkbook.Path & "/" & myFolderName & "/*.xls" myFileName = Dir(myPath) ''''''''''''''''''''''''''''''''''' 'Dim iCounter As Integer 'iCounter = 0 '遍历指定目录下的文件并操作 Do ''''''''''''''''''''''''''''''''''''' Debug.Print myFileName Dim searchStr As String '通用搜索字符串 Dim resStr As String '通用结果字符串 Dim iCount As Integer '通用计数器 myFileName = ThisWorkbook.Path & "/" & myFolderName & "/" & myFileName '打开指定目录里的一个*.xls文件 'Debug.Print myFileName Set myCurOpenWB = Workbooks.Open(myFileName) Set myCurOpenWS = myCurOpenWB.Sheets("附件1") '打开文件的sheet附件1里是分条数据 '插入内容行 Dim iC As Integer For iC = 0 To 3 '插入内容行 myTotalWS.Rows(6).Insert myTotalWS.Rows(6).RowHeight = 14.25 myTotalWS.Range("B6:Q6").NumberFormat = "@" '将它们的数字格式设置成文本 Next '##################################复制数据过程###################################### '序号 =Row()-5 myTotalWS.Range("A6").Formula = "=INT(Row()/4)" '姓名 C4 myTotalWS.Range("B6").Value = myCurOpenWS.Range("C4").Value '性别 F4 myTotalWS.Range("C6").Value = myCurOpenWS.Range("F4").Value '出生年月 C6 myTotalWS.Range("D6").Value = myCurOpenWS.Range("C6").Value '身份证 D8 myTotalWS.Range("E6").Value = myCurOpenWS.Range("D8").Value '进厂劳动时间 B21-B25 myTotalWS.Range("F6").Value = myCurOpenWS.Range("B21").Value myTotalWS.Range("F7").Value = myCurOpenWS.Range("B22").Value myTotalWS.Range("F8").Value = myCurOpenWS.Range("B23").Value myTotalWS.Range("F9").Value = myCurOpenWS.Range("B24").Value '离岗时间 B21-B25 '劳动年限 I26 myTotalWS.Range("H6").Value = myCurOpenWS.Range("I26").Value '原用工单位 D21-D25 'myTotalWS.Range("I6").Value = myFolderName myTotalWS.Range("I6").Value = myCurOpenWS.Range("D21").Value myTotalWS.Range("I7").Value = myCurOpenWS.Range("D22").Value myTotalWS.Range("I8").Value = myCurOpenWS.Range("D23").Value myTotalWS.Range("I9").Value = myCurOpenWS.Range("D24").Value '用工类别 D26 myTotalWS.Range("J6").Value = "家属工" '已享受保障 B28-B30 searchStr = myCurOpenWS.Range("B28").Value resStr = "" iCount = 0 If InStr(searchStr, "√") <> 0 Then resStr = resStr & "城市最低生活保障" iCount = iCount + 1 End If searchStr = myCurOpenWS.Range("B29").Value If InStr(searchStr, "√") <> 0 Then If iCount <> 0 Then resStr = resStr & "、" End If resStr = resStr & "遗属生活困难补助" iCount = iCount + 1 End If searchStr = myCurOpenWS.Range("B30").Value If InStr(searchStr, "√") <> 0 Then If iCount <> 0 Then resStr = resStr & "、" End If resStr = resStr & "供养亲属抚恤费" End If myTotalWS.Range("K6").Value = resStr '已参加社保 B32-B34 searchStr = myCurOpenWS.Range("B32").Value resStr = "" iCount = 0 If InStr(searchStr, "√") <> 0 Then resStr = resStr & "企业职工养老保险" iCount = iCount + 1 End If searchStr = myCurOpenWS.Range("B33").Value If InStr(searchStr, "√") <> 0 Then If iCount <> 0 Then resStr = resStr & "、" End If resStr = resStr & "灵活就业人员养老保险" iCount = iCount + 1 End If searchStr = myCurOpenWS.Range("B34").Value If InStr(searchStr, "√") <> 0 Then If iCount <> 0 Then resStr = resStr & "、" End If resStr = resStr & "城镇居民医疗保险" End If myTotalWS.Range("L6").Value = resStr '配偶姓名 C10 myTotalWS.Range("M6").Value = myCurOpenWS.Range("C10").Value '配偶现所在单位 myTotalWS.Range("N6").Value = "重型车厂" '配偶人员类别 C12 'myTotalWS.Range("O6").Value = myCurOpenWS.Range("C12").Value searchStr = myCurOpenWS.Range("C12").Value If InStr(searchStr, "√去世") <> 0 Then myTotalWS.Range("O6").Value = "去世" ElseIf InStr(searchStr, "√离休") <> 0 Then myTotalWS.Range("O6").Value = "离休" ElseIf InStr(searchStr, "√退休") <> 0 Then myTotalWS.Range("O6").Value = "退休" ElseIf InStr(searchStr, "√退养") <> 0 Then myTotalWS.Range("O6").Value = "退养" Else myTotalWS.Range("O6").Value = "在职" End If '备注 myTotalWS.Range("P6").Value = myFolderName '联系电话 myTotalWS.Range("Q6").Value = myCurOpenWS.Range("H18").Value '################################复制数据过程结束############################# '关闭打开的文件 myCurOpenWB.Close myFileName = Dir '''''''''''''''''''''''''''''' ' iCounter = iCounter + 1 Loop Until myFileName = "" ''''''''''''''''''''''''''''' End Sub