如何將多個同樣式的excel表匯總成一個？

01-27

把後面的都匯總，羅列出來就行，表的樣式完全一樣的。

可以使用《逸凡工作簿合併助手》，輕鬆合併多工作表

我在#微盤#分享了一個超贊的文件："逸凡工... 來自龍逸凡

貼一個原來寫的合併文件的宏，其實這些宏代碼可以在網上找到自己改寫的，如果題主你不會，我就攤攤手。。。

Option Explicit

對文本中的大小寫是敏感的

Private Sub DataMergeToFile()

通用文件合併程序

Dim i As Long

Dim j As Long

Dim k As Long

Dim myPath As String

Dim MyName As String

Dim OutFile As Variant 合併後的主文件名

Dim strFolder As String 合併後主文件所在的目錄

Dim SecFolder As String 次要文件所在目錄

Application.DisplayClipboardWindow = False

要求輸入合併之後的文件名稱，如果取消，就退出程序

OutFile = Application.InputBox("請輸入合併後的文件名稱！", "文件名")

If OutFile = False Then Exit Sub

插入一個新工作表

Workbooks.Add

打開文件框窗口，選取合併的主文件保存的目錄

With Application.FileDialog(msoFileDialogFolderPicker)

用對話框選擇一個目錄

.Title = "請選擇合併後文件保存所在的目錄！"

.Show

If .SelectedItems.Count = 0 Then Exit Sub

strFolder = .SelectedItems(1)

End With

存儲合併的主文件

If Not Right(strFolder, 1) Like "" Then strFolder = strFolder ""

ActiveWorkbook.SaveAs fileName:=strFolder OutFile ".xlsx"

ActiveWorkbook.Close

重新打開合併的主文件

Workbooks.Open fileName:=strFolder OutFile ".xlsx"

打開文件框窗口，選取合併的次文件所在目錄

With Application.FileDialog(msoFileDialogFolderPicker)

用對話框選擇一個目錄

.Title = "請選擇需要合併的文件所在的目錄！"

.Show

If .SelectedItems.Count = 0 Then Exit Sub

SecFolder = .SelectedItems(1)

End With

指定合併開始

myPath = SecFolder "" 指定路徑。

MyName = Dir(myPath, vbNormal) 找尋第一項。

Do While MyName &<&> "" 開始循環。

If MyName &<&> "." And MyName &<&> ".." Then

使用位比較來確定 MyName 代表一目錄。

If (GetAttr(myPath MyName) And vbNormal) = vbNormal Then

Debug.Print MyName 如果它是一個文件，將其名稱顯示出來。

Workbooks.Open fileName:=myPath MyName 打開需要合併的文件

Range("A1").Select

Selection.CurrentRegion.Select

i = ActiveSheet.UsedRange.Rows.Count

j = ActiveSheet.UsedRange.Columns.Count

Selection.Copy 拷貝數據

Workbooks(OutFile ".xlsx").Activate

k = ActiveSheet.UsedRange.Rows.Count

If k &> 1 Then k = k + 1

Debug.Print k 定位到總合併文件的最後一行

Range("A" k).PasteSpecial xlPasteValues

Application.CutCopyMode = False 關閉剪貼板

Range(Cells(k, j + 1), Cells(k + i - 1, j + 1)).Value = MyName

Workbooks(MyName).Close False 不保存原文件

Kill myPath MyName

End If

MyName = Dir 查找下一個。

Loop

Windows(OutFile ".xlsx").Activate

自定義部分，隨時修改符合個性需求

i = Cells(1, 1).CurrentRegion.Rows.Count

Columns("J:J").NumberFormatLocal = "yyyy/m/d"

Range("s1") = "成本金額"

Range("t1") = "零售金額"

Range("s2").FormulaR1C1 = "=RC[-2]*RC[-7]"

Range("t2").FormulaR1C1 = "=RC[-8]*RC[-2]"

Range("s2:t2").Select

Selection.AutoFill Destination:=Range("s2:t" i)

Range("s2:t" i).Select

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

For j = i To 2 Step -1

If Range("A" j) = "序號" Then Rows(j ":" j).Delete Shift:=xlUp

ActiveWorkbook.Save

End Sub

摸索過這個問題，當初考慮過學習VBA來解決，最後覺得過於複雜。最終找到了一款足夠讓人滿意的插件輕鬆解決問題。

本答案唯一重點：kutools-for-excel插件

-----------------------------------------------------------

簡要介紹一下這個插件：看圖

仔細看一下，裡面有很多非常方便的功能，這裡我們使用的主要是企業選項卡中的「會總」和「分割數據」功能。更多功能等待開發，不過我還是學生很多功能都用不上。

-------------------------------------------------------------

具體的合併步驟：繼續看圖

已經提供了表頭行數等各種設置選項，四種匯總方式想必是夠用了。照著步驟來，很容易就能完成合併生成一張新表（準確地說是兩張，還有一張是各個源文件的名稱和鏈接）。

-------------------------------------------------------------

後續操作和處理

雖然提供了標題行數等選項，還是很可能有很多不需要的內容被合併進了新表。一般再簡單地處理就可以搞定。

具體的操作基本上就是篩選、排序、F5定位功能鍵找到空行或者不需要的行，再直接刪除整行即可，題主應該很容易就能處理好。

-------------------------------------------------------------

其他問題：

kutools是收費工具，但是提供了210天的免費試用（真-良心），而且目前也沒有發現直接使用有任何限制。
速度的問題，在選擇文件載入進去和合併文件的時候會有點慢，電腦配置低、文件特別巨大的時候等待時間可能有點長，當然這不是插件的問題。

-------------------------------------------------------------

最近在寫簡易的Excel教程給完全不懂Excel的學弟學妹，有一篇恰巧就是這一部分內容。

下面是鏈接：Excel學習：03-郵箱附件下載文件合併

下載excel易用寶，excelhome出品的，免費

建議去excelhome下載各式插件或者各種寶，每天準時下班不是夢

把加粗的數字改成你的表列數

Sub huizong()
Dim bt As Range, r As Long, c As Long bt為表頭
r =2 表頭的行數
c = 13 表頭的列數
Range(Cells(r, "A"), Cells(65536, c)).ClearContents 清除匯總表中的原表內數據
Application.ScreenUpdating = False
Dim filename As String, wb As Workbook, erow As Long, fn As String, arr As Variant
filename = Dir(ThisWorkbook.Path "*.xls")
遍歷該文件夾下所有xls文件
Do While filename &<&> ""
If filename &<&> ThisWorkbook.Name Then
判斷該文件是否本工作簿
erow = Range("A1").CurrentRegion.Rows.Count + 1 取得匯總表中第一條空行行號
fn = ThisWorkbook.Path "" filename
Set wb = GetObject(fn) 將fn代表的工作簿對象賦給變數
Set sht = wb.Worksheets(1)
arr = sht.Range(sht.Cells(r, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, 13))
將數據表中的記錄保存在arr數組裡
Cells(erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
將數組arr中的數據寫入工作表
wb.Close False
End If

隨便百度一段兒代碼，貼到vbe裡面，運行就可以了，不行就再換一段兒試試，最多試兩次就成功了

用EXCEL插件就可以很便利地處理，推薦：方方格子