Excel 加油站职场Office技巧

excel汇总表

2019-05-13  本文已影响47人  千千鹤儿飞翔

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

重要的是逻辑,代码函数也要慢慢学!

上一篇 下一篇

猜你喜欢

热点阅读