批量提取同一文件夹内多个excel表格中的指定区域单元格内容汇总到一个表格中
本工具，最好使用excel2007，当然excel2010也能使用，但是所要操作的文件中千万别有由wps所建的excel表格，否则，会出错，程序运行不下去。
本工具用途：
先假设你在一个文件夹“A”中，有若干个excel工作薄b,c,d,e,f,……，，这些工作薄中都有一个SHEET1的工作表，并且所有工作薄中的sheet1工作表的格式都是一样的，只不过是里面的数据不一样，也就是说，如果我想提取所有这些sheet1里面的某一个区域的内容，前提是这个内容要在每个sheet1中的位置是相同的，换句话就是说，本工具，是根据你指定的某个区域的位置，然后在所有表格中把该位置的内容都提取出来。提取出来的数据，会放在本工具“合并汇总表”这个工作表中。
说了这么多，还是下下来试试，大家就知道其具体功能了。用起来很简单的，对于需要把n多相同格式文件里面的内容汇总是很有用的。
批量提取excel指定区域内容到一个工作表中VBA工具下载
(56.56 KB, 下载次数: 1774)
18:01 上传
点击文件名下载附件
width:100%">
楼主您好，我下载了您的表格打开后，提示& &&&部件 /xl/vbaProject.bin。 (Visual Basic for Applications (VBA))删除，请问您是否知道哪里的问题，麻烦了，
单击 Windows 任务栏上开始， 单击运行, 然后键入下面
Regsvr32.exe fm20.dll
单击确定。 应出现： 以下消息
c:\windows\system\fm20.dll 中的 DllRegisterServer 成功。
是fm20.dll的问题，重新装下就ok&
请问你用的是哪个版本系统。&
width:100%">
楼主您好，我下载了您的表格打开后，提示& &&&部件 /xl/vbaProject.bin。 (Visual Basic for Applications&&...
请问你用的是哪个版本的office
width:100%">
楼主您好，我下载了您的表格打开后，提示& &&&部件 /xl/vbaProject.bin。 (Visual Basic for Applications&&...
单击 Windows 任务栏上开始， 单击运行, 然后键入下面
Regsvr32.exe fm20.dll
单击确定。 应出现： 以下消息
&&c:\windows\system\fm20.dll 中的 DllRegisterServer 成功。
是fm20.dll的问题，重新装下就ok了
你试试按照上面的方法，能不能解决问题。
width:100%">
Copyright & & &All Right Reserved
网站声明： 本站资源收集于互联网或为网友发布，嘻皮客网不承担任何由于内容的合法性及健康性所引起的争议和法律责任。欢迎大家对网站内容侵犯版权等不合法和不健康行为进行监督和举报。举报：
技术支持：&&&风格支持: &&&运营团队：&&&5199人阅读
OFFICE/VBA（3）
&&& 现要求:给出一个空汇总表,给出若干单独的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 = "@"
'将它们的数字格式设置成文本
'##################################复制数据过程######################################
'序号 =Row()-5
myTotalWS.Range("A6").Formula = "=INT(Row()/4)"
myTotalWS.Range("B6").Value = myCurOpenWS.Range("C4").Value
myTotalWS.Range("C6").Value = myCurOpenWS.Range("F4").Value
myTotalWS.Range("D6").Value = myCurOpenWS.Range("C6").Value
'身份证 D8
myTotalWS.Range("E6").Value = myCurOpenWS.Range("D8").Value
'进厂劳动时间
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
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
myTotalWS.Range("J6").Value = "家属工"
'已享受保障 B28-B30
searchStr = myCurOpenWS.Range("B28").Value
resStr = ""
iCount = 0
If InStr(searchStr, "&") && 0 Then
resStr = resStr & "城市最低生活保障"
iCount = iCount + 1
searchStr = myCurOpenWS.Range("B29").Value
If InStr(searchStr, "&") && 0 Then
If iCount && 0 Then
resStr = resStr & "、"
resStr = resStr & "遗属生活困难补助"
iCount = iCount + 1
searchStr = myCurOpenWS.Range("B30").Value
If InStr(searchStr, "&") && 0 Then
If iCount && 0 Then
resStr = resStr & "、"
resStr = resStr & "供养亲属抚恤费"
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
searchStr = myCurOpenWS.Range("B33").Value
If InStr(searchStr, "&") && 0 Then
If iCount && 0 Then
resStr = resStr & "、"
resStr = resStr & "灵活就业人员养老保险"
iCount = iCount + 1
searchStr = myCurOpenWS.Range("B34").Value
If InStr(searchStr, "&") && 0 Then
If iCount && 0 Then
resStr = resStr & "、"
resStr = resStr & "城镇居民医疗保险"
myTotalWS.Range("L6").Value = resStr
myTotalWS.Range("M6").Value = myCurOpenWS.Range("C10").Value
'配偶现所在单位
myTotalWS.Range("N6").Value = "重型车厂"
'配偶人员类别
'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 = "退养"
myTotalWS.Range("O6").Value = "在职"
myTotalWS.Range("P6").Value = myFolderName
myTotalWS.Range("Q6").Value = myCurOpenWS.Range("H18").Value
'################################复制数据过程结束#############################
'关闭打开的文件
myCurOpenWB.Close
myFileName = Dir
''''''''''''''''''''''''''''''
iCounter = iCounter + 1
Loop Until myFileName = "" '''''''''''''''''''''''''''''
* 以上用户言论只代表其个人观点，不代表CSDN网站的观点或立场
访问：209282次
积分：4330
积分：4330
排名：第3798名
原创：224篇
评论：68条
阅读：6933
(1)(1)(2)(1)(1)(1)(2)(1)(1)(1)(2)(2)(4)(3)(1)(1)(5)(1)(1)(3)(3)(2)(4)(2)(3)(10)(6)(12)(16)(11)(1)(4)(15)(11)(10)(12)(5)(1)(10)(13)(25)(5)(1)(4)(1)(2)(1)(1)(1)(1)(1)}