EXCEL如何把同一個目錄下多個工作薄合並到一個工作薄

【引言】

　　有的時候我們需要把某個目錄下多個工作薄文件合並到一個文件，比如：一個小商店每個月都有一個以月份為名稱的結算表，到了年底，可能需要把它們合成一個以年度為名稱的工作薄，一是精簡文件，二是方便管理，如何實現？(以下方法均針對需要合並的工作薄中都只有一個工作表)

【實現方法一】

　　如果文件名稱是確定的，且有規律,比如合並1,2,3月到一季度,那么可以先新建一個空白工作薄，錄制一個宏，把其中一個工作薄中工作表移動/復制到新工件薄中,再修改,此時我們可以得到以下代碼

Sub 宏1()
'
' 宏1 宏
'

'
    Workbooks.Open Filename:="C:\Users\hp\Desktop\1月.xlsx"
    Sheets("Sheet1").Select
    Sheets("Sheet1").Move After:=Workbooks("工作簿1").Sheets(1)
　　 ActiveWorkbook.SaveAs Filename:="C:\Users\hp\Desktop\一季度.xlsm", FileFormat _:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

　　然后我們把另外兩個加進來就好,方法是復制並修改代碼(這種方法對初學者比較適用)

Sub 宏1()
'
' 宏1 宏
'

'
    Workbooks.Open Filename:="C:\Users\hp\Desktop\2月.xlsx" '1月己加進來,處理后面兩月就好
    Sheets("Sheet1").Select
    Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(1) '工作薄名稱己改變了,這里也跟着改,當然在第一步時也可以先不保存,這里就不用改了
    Workbooks.Open Filename:="C:\Users\hp\Desktop\3月.xlsx"
    Sheets("Sheet1").Select
    Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(1)
    'ActiveWorkbook.SaveAs Filename:="C:\Users\hp\Desktop\一季度.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接保存就好
End Sub

　　至此,在一季度工作薄中便有四個工作表,多出來的一個是新建工作表時的空表。但我們發現兩個問題：1.順序是倒的    2.名稱混亂。此兩問題將在下一方法中一並處理

【實現方法二】

　　對於第一個方法,只有三個文件還好,文件多了也很麻煩,比如1-12月合並到一年,這時我們可以使用循環,當然這需要我們懂一點VBA基礎(不會也沒關系,百度查查就好,前提是我們知道有"循環"這個概念)。當下需要處理的是文件名稱和位置,它們每次都在變化,所以,可以用變量實現。

　　1.文件名稱   可以用一個變量fn表示,它的原型是"C:\Users\hp\Desktop\1月.xlsx",我們首先用一個計數器i(每循環都會加1),現在把"1月"中的"1"分離出來就可以了,fn="C:\Users\hp\Desktop\" & 1 &"月.xlsx",然后把那個1用變量i替換,即fn = "C:\Users\hp\Desktop\" & i & "月.xlsx",這樣隨着i的改變,文件名稱也跟着變了。

　　2.位置  在第一個方法里我們發現工作每次插入的位置都在第一個工作表之后,實際上應該在最后比較好,即第1次在第1個工作表之后,第2次就應該在第2個工作表之后,那很容易得知第i次應該在第i個工作表之后,親愛的讀者,你知道修改哪里了嗎?(不知道的朋友請看代碼)

好吧,我們把剛才插入的工作全部刪除,修改宏1的代碼如下,再運行試試

Sub 宏1()
'
' 宏1 宏
'

'
   For i = 1 To 3
        fn = "C:\Users\hp\Desktop\" & i & "月.xlsx"
        Workbooks.Open Filename:=fn
        Sheets("Sheet1").Select
        Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(i)
    Next i
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接保存就好
End Sub

　　　　還有一個問題:工作的名稱沒有修改,我們可以把它修改為之前工作薄的名稱,當然得去掉目錄。這個問題不會的朋友可以百度,也可以單獨錄制一個修改工作表名稱的宏查看代碼,當然這里需要分離出目錄和文件擴展名等,工作表名稱只需要主要部分就可以了。直接上代碼(注意代碼中的紅色部分)

Sub 宏1()
'
' 宏1 宏
'mypath = "C:\Users\hp\Desktop\"
   For i = 1 To 3
        fn = i & "月"
        Workbooks.Open Filename:=mypath & fn & ".xlsx"
        Sheets("Sheet1").Select
        Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(i)
        Sheets(i + 1).Name = fn
    Next i
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接保存就好
End Sub

【實現方法三】

　　　　如果文件名稱沒啥規律或者規律難以用變量+公式實現怎么辦?這時,我們可以考慮用數組——把文件名全寫入數組,再利用前面的循環。這時可以需要一些新的知道——字符串分割為數組(如果不會也可以直接單個輸入)

Sub 宏1()
'
' 宏1 宏
'

'
    mypath = "C:\Users\hp\Desktop\"
    Dim fn As Variant
    fn = Array("", "1月", "2月", "3月")
    Rem 以下兩行是上面兩行的另一種等效實現方式
    'Dim fn As String
    'fn = Split(",1月,2月,3月", ",")  '數組下標一般從0開始,前面一個逗號目的是讓第一個為空,真正要用的數據便從1開始
    For i = 1 To 3
        Workbooks.Open Filename:=mypath & fn(i) & ".xlsx"
        Sheets("Sheet1").Select
        Sheets("Sheet1").Move After:=Workbooks("一季度").Sheets(i)
        Sheets(i + 1).Name = fn(i)
    Next i
    
    ActiveWorkbook.Save '第一次沒起名,用另存為,現在可以直接保存就好
End Sub

 【實現方法四】

　　如果需要處理的文件較多,文件名稱還沒啥規律,那么我們可以用這種方法。首先,我們先新建一個工作薄,並把文件另存為"啟用宏的工作薄"(擴展名為.xlsm)。其次打開VBA編輯環境,插入類模塊,新建一個程序。

Sub 合並工作表()

Application.ScreenUpdating = False '為了提高程序運算速度,關閉屏幕刷新
mypath = "C:\Users\hp\Desktop\" '這時你可以換成你需要的目錄
fn = Dir(mypath & "*.xlsx")
Do While fn <> ""
    Workbooks.Open Filename:=mypath & fn
    Sheets(1).Move After:=Workbooks("一季度").Sheets(Workbooks("一季度").Sheets.Count)
    Sheets(Sheets.Count).Name = Left(fn, InStr(fn, ".") - 1)  '這里的fn是帶擴展名的文件名,工作名稱需要去掉.xlsx
    fn = Dir
Loop
'Sheets(1).Delete  '第一個工作表是新建時默認添加的去掉
ActiveWorkbook.Save '保存
Application.ScreenUpdating = True '程序運行完成,恢復屏幕刷新

End Sub