VBA汇总文件夹中的多文件的工作表中不同单元格区域到总表
【问题】我们发了这样一个表格到各单位收集资料,各单位填写完后上交上来有许多个文件,我们现在想汇总成一年一个表,怎么办?
◆表格是先设定后的一样的格式
◆收上来后有很多个文件
◆我们想汇总成这样的“一年一个汇总表”
【难点】正常的做法是一个文件打开---复制2016年的—粘贴………再复制2017年的—粘贴…………再复制2018年的—粘贴,----关闭文件,再打开一个文件………………
如果几个文件还好,如果是一百多个,1k个呢,1w个呢,!那就加班,再加班
【解决问题】我们的口号是VBA使工作效率提高,不加班
====【代码】====
Sub 提取多文件一工作表中不同区域汇总()
Dim fileToOpen, x, total_file_path, m, title_row
Dim MyOb As Object, rng As Range ', rng_1 As Range, rng_2 As Range
Dim sht2016 As Worksheet, sht2017 As Worksheet, sht2018 As Worksheet
fileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , "打开文件", , True)
If TypeName(fileToOpen) = "Boolean" Then MsgBox "你选择了“取消”,将要退出程序": Exit Sub
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set sht2016 = Worksheets("2016")
Set sht2017 = Worksheets("2017")
Set sht2018 = Worksheets("2018")
sht2016.Range("a5:t300").Clear
sht2017.Range("a5:t300").Clear
sht2018.Range("a5:t300").Clear
m = 0
On Error Resume Next
For Each rr In fileToOpen
Set MyObj = GetObject(rr)
With MyObj
With MyObj.Worksheets("Sheet1")
.Range("a5:t11").Copy
Lrow = sht2016.Cells.Find("*", Cells(1, 1), , , 1, 2).Row + 1
sht2016.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
.Range("a17:t23").Copy
Lrow = sht2017.Cells.Find("*", Cells(1, 1), , , 1, 2).Row + 1
sht2017.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
.Range("a29:t35").Copy
Lrow = sht2018.Cells.Find("*", Cells(1, 1), , , 1, 2).Row + 1
sht2018.Range("A" & Lrow).PasteSpecial Paste:=xlPasteValues
m = m + 1
End With
.Close False
End With
Set MyObj = Nothing
Next
On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完成!共汇总文件数:" & m
End Sub
====【解析】====
1. 用Application.GetOpenFilename打开一个选择文件的对话框,可以多选,把选择的文件存入到fileToOpen的数据中
2.循环数组,
3.打开一个文件,并复制全部的区域,到指定的2016-2018的表格中,下一次的复制,复制到最后的一行中的A列中,
4.因为在打开文件的过程中可能有些人在传输文件中,文件损坏了,所以加上On Error Resume Next,不报错继续运行。到时汇总完成了再来检查那个文件坏了。
====【遇到的坑】====
本来我想打开一个文件,再用Union所在的区域,最后再复制,但这里遇到问题,也算是学习了,
代码如下:
'用GetObject打开文件后
If rn Is Nothing Then
Set rn = .Range("a5:t11")
Else
Set rn = Union(rn, .Range("a5:t11"))
End If
'再关闭文件,再循环一次
'文件循环完成后,判断并且复制
If Not rn Is Nothing Then
rn.Copy .Range("A6")
End If
结果发现是不可行的,原因是:初值中是.Range("a5:t11"),想要组合进行的也是.Range("a5:t11"),所以程序是不可以的。这里留下个记号吧!
====【效果】====
最后完成
====今天就学习至此====