花了好几天时间想思路，找Excel函数公式和vba代码，不停地推翻思路重新来。最后终于做好了，虽然手动输入可能也得花这几天时间，但做完之后成就感爆棚啊!
大致内容是有500+单独的excel样式的加盟合同台账，我要提取其中200+加盟商六个费用的的对应值。
1.我把标有无合同字样和多余的excel表格删除，剩下400+excel。
2.用vba把它们汇总成一个excel的多个sheet，把这些sheet的名称做成目录，摘取目录中的ID信息。
打开excel表，ALT+F11-->打开VBA编辑器-->插入-->模块
vba代码如下：
Sub MergeWorkbooks()
Dim FileSet
Dim i As Integer
On Error GoTo 0
Application.ScreenUpdating = False
FileSet = Application.GetOpenFilename(FileFilter:="Excel 2016(*.xls),*.xls,Excel 2016(*.xlsx),*.xlsx", _
MultiSelect:=True, Title:="选择要合并的文件")
If TypeName(FileSet) = "Boolean" Then
GoTo ExitSub
End If
For Each Filename In FileSet
Workbooks.Open Filename
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next
ExitSub:
Application.ScreenUpdating = True
End Sub
3.再用vba把这些sheet的内容汇总到一个表里。对关键字做筛选，摘取自己要的关键信息，与目录的ID信息汇总。
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(what:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Sub MergeSheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
'新建一个“汇总”工作表
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("汇总").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "汇总"
'开始复制的行号，忽略表头，无表头请设置成1
StartRow = 2
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
If shLast > 0 And shLast >= StartRow Then
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "内容太多放不下啦！"
GoTo ExitSub
End If
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
End If
Next
ExitSub:
Application.GoTo DestSh.Cells(1)
DestSh.Columns.AutoFit
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
4.最后做个vlookup函数，对标200+ID信息。
说起来很容易，但碰到过很多麻烦。
1.500+excel表格数据量太大，用vba还是会出现错误的地方，还好只是sheet标题改了，还会有多余重复名称的sheet，只能手动改了。
2.因为是不同的人做的表格，有的表格格式不规范，导致后来筛选的数据与目录ID对不上，只能手动找了。也是心累，还好不多。。。
3.最大的难点是每张sheet的内容没有ID信息，我最开始想过要不要在每张sheet上加上ID内容，但是一直没找到好方法，只得作罢，ID信息只有sheet标题上有。所以只有保证汇总sheet的顺序与目录ID的顺序一致就行。所以每张单独sheet的格式必须规范了，也就是提醒我们说，平时的基础工作不要偷懒啊啊啊啊啊!
PS：VBA代码一点也看不懂，全是网上复制粘贴的，在此附上链接
https://blog.csdn.net/nsj820/article/details/6327216
重要的是逻辑，代码函数也要慢慢学！
网友评论