易顺网

当前位置:首页 > 八爪鱼相关 / 正文
后台-系统设置-扩展变量-手机广告位-内容页头部广告位
作者:admin

八爪鱼专用版合并xlsx表格

admin 11个月前(2018-04-18) 八爪鱼相关

副标题:仅合并第一个表头


八爪鱼导出表格为2万条一个文件,字段多的话是4千条数据一个表格。


后期处理数据肯定是要把数据合在一个表格里的,但数据量大的话,


复制粘贴就很累了,我不得不借助工具来合并。


原来的三个表格数据是这样的(为便于演示,只取了部分数据),


01.png


02.png


03.png



合并后的数据是这样的,



06.png



VBA源代码如下,朋友帮忙写的。


Sub 合并当前目录下所有工作簿的全部工作表()

    Dim MyPath, MyName, AWbName

    Dim Wb As Workbook, WbN As String

    Dim G As Long

    Dim Num As Long

    Dim BOX As String

    Dim mybk

    Set mybk = ThisWorkbook.Sheets(1)

    Application.ScreenUpdating = False

    MyPath = ActiveWorkbook.Path

    MyName = Dir(MyPath & "\" & "*.xlsx")

    AWbName = ActiveWorkbook.Name

    Num = 0

    Do While MyName <> ""

        If MyName <> AWbName Then

            Set Wb = Workbooks.Open(MyPath & "\" & MyName)

            With Workbooks(1).ActiveSheet

'                .Cells(.Range("A1048576").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

                For G = 1 To Sheets.Count

                    Num = Num + 1

                    If Num = 1 Then

                        Wb.Sheets(G).UsedRange.Copy mybk.Cells(mybk.Range("A1048576").End(xlUp).Row, 1)

                    Else

                        Wb.Sheets(G).UsedRange.Offset(1, 0).Copy mybk.Cells(mybk.Range("A1048576").End(xlUp).Row + 1, 1)

                    End If

                Next

                WbN = WbN & Chr(13) & Wb.Name

                Wb.Close False

            End With

        End If

        MyName = Dir

    Loop

    Range("A1").Select

    Application.ScreenUpdating = True

    MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "e提示" 

End Sub


我网盘的资料都设置了解压密码:www.e123456.com,防止网盘的资料被和谐。

大小:41K | 来源: | 提取码:g76g
已经过安全软件检测无毒,请您放心下载。

标 签

试试用"←"或"→"方向键快速翻页把 (^o^)/

后台-系统设置-扩展变量-手机广告位-内容页头部广告位
搜索
热门图片
最近更新

Powered By 易顺网  赣ICP备16001451号