excel汇总表

花了好几天时间想思路，找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

重要的是逻辑，代码函数也要慢慢学！