Excel合并工具(支持WPS及OFFICE全系)

Excel合并工具1.1綠色版這里為大家?guī)�來！這是一款綠色免費的Excel表格數(shù)據(jù)合并工具，具有簡單易用的特點，用戶只需選擇需要合并的表格然后輕輕一點就能輕松合并目標表格中的所有數(shù)據(jù)了。歡迎有需要的朋友前來西西下載使用！

工具介紹

工作中經(jīng)常要把Excel發(fā)給學生填數(shù)據(jù)，之后還要合并，很是勞神。網(wǎng)上找到的不是要錢，就是太麻煩，所以開發(fā)本軟件。

功能特點

軟件適用于標題行+嫩據(jù)行的普通表格。要求將文件放在同一個文件夾中，結構相同，最多26列，數(shù)據(jù)里不限。正常使用需安裝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) '必須重新定義數(shù)組的維度

                              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("名稱", "代號", "長度", "數(shù)量")

              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")  就行。

相關視頻