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

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

工具介紹

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

功能特點(diǎn)

軟件適用于標(biāo)題行+嫩據(jù)行的普通表格。要求將文件放在同一個(gè)文件夾中，結(jié)構(gòu)相同，最多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("名稱(chēng)", "代號(hào)", "長(zhǎng)度", "數(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 "匯總報(bào)表用時(shí)" & s - Timer & "秒"

End Sub

注意事項(xiàng)

1.要在工作簿所在文件里新建一個(gè)工作簿，把這段代碼放到VBE編輯器中，并存為.xlsm格式。

2.f = Dir(ThisWorkbook.Path &"\*test*.xlsx")這句代碼是用來(lái)識(shí)別你文件夾下文件名稱(chēng)的，其實(shí)中間的test沒(méi)有必要寫(xiě)，我這是看每個(gè)文件的文件名都有test，才這樣寫(xiě)的。寫(xiě)成：f = Dir(ThisWorkbook.Path & "\*.xlsx")  就行。

相關(guān)視頻