Excel合并工具(支持WPS及OFFICE全系)v1.1 最新绿色版

Tags：Excel合并工具,Excel数据合并

Excel合并工具1.1绿色版这里为大家带来！这是一款绿色免费的Excel表格数据合并工具，具有简单易用的特点，用户只需选择需要合并的表格然后轻轻一点就能轻松合并目标表格中的所有数据了。欢迎有需要的朋友前来西西下载使用！

工具介绍

工作中经常要把Excel发给学生填数据，之后还要合并，很是劳神。网上找到的不是要钱，就是太麻烦，所以开发本软件。

功能特点

软件适用于标题行+嫩据行的普通表格。要求将文件放在同一个文件夹中，结构相同，最多26列，数据里不限。正常使用需安装WPS或Office。

Excel合并代码

Option Explicit

Sub 汇总2()

     Dim i%, j%, f$, k%, n%, m%

     Dim wb As Workbook, sht As Worksheet

     Dim d As Object, s

     Dim arr, arr1()

     Set d = CreateObject("scripting.dictionary")

      s = Timer

      f = Dir(ThisWorkbook.Path & "\*test*.xlsx")

      Application.ScreenUpdating = False

      Application.DisplayAlerts = False

      Do While f <> ""

               Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)

               For Each sht In Worksheets

                         sht.Activate

                         i = [a100000].End(3).Row

                         arr = Range("A3:D" & i)

                         For k = 1 To UBound(arr)

                         If Not d.exists(arr(k, 1) & arr(k, 2) & arr(k, 3)) Then

                              n = n + 1

                              d(arr(k, 1) & arr(k, 2) & arr(k, 3)) = n

                              ReDim Preserve arr1(1 To 4, 1 To n) '必须重新定义数组的维度

                              arr1(1, n) = arr(k, 1)

                              arr1(2, n) = arr(k, 2)

                              arr1(3, n) = arr(k, 3)

                              arr1(4, n) = arr(k, 4)

                         Else

                              m = d(arr(k, 1) & arr(k, 2) & arr(k, 3))

                              arr1(4, m) = arr1(4, m) + arr(k, 4)

                         End If

                         Next k

                         Erase arr

               Next sht

               wb.Close False

     f = Dir

     Loop

              Range("A2").Resize(d.Count, 4) = Application.Transpose(arr1)

              Range("A1:D1") = Array("名称", "代号", "长度", "数量")

              ActiveWorkbook.Worksheets("汇总2-字典").Sort.SortFields.Clear

              ActiveWorkbook.Worksheets("汇总2-字典").Sort.SortFields.Add Key:=Range("A8"), _

              SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

              With ActiveWorkbook.Worksheets("汇总2-字典").Sort

                  .SetRange Range("A2:D10")

                  .Header = xlNo

                  .MatchCase = False

                  .Orientation = xlTopToBottom

                  .SortMethod = xlPinYin

                  .Apply

               End With

              MsgBox "汇总报表用时" & s - Timer & "秒"

End Sub

注意事项

1.要在工作簿所在文件里新建一个工作簿，把这段代码放到VBE编辑器中，并存为.xlsm格式。

2.f = Dir(ThisWorkbook.Path &"\*test*.xlsx")这句代码是用来识别你文件夹下文件名称的，其实中间的test没有必要写，我这是看每个文件的文件名都有test，才这样写的。写成：f = Dir(ThisWorkbook.Path & "\*.xlsx")  就行。