excel-合並多個Excel文件--VBA合並當前目錄下所有Excel工作簿中的所有工作表


在網上找EXCEL多文件合並的方法,思路:

一、Linux 或者window+cmder,直接用命令行cat合並EXCEL文件,但是,需要安裝輔助東西才能直接處理(也許也不可以,但是,可以用文件格式轉換工具轉換是可行的,把EXCEL文件轉換成txt文件,再操作,操作好了,再轉換成EXCEL格式);還有一種是perl或者Python有自己自帶的EXCEL處理包,能像處理數組一樣,實現直接處理EXCEL文件的目的

二、EXCEL自帶VBA編程實現合並,但是,網上搜了很多,格式很類似的VBA腳本,都不能很完美的實現合並功能,都或多或少合並有不完整的現象,於是遇到下面的這個版本,可以很好正確的實現合並,就在此把腳本里邊每條的功能給詳細注釋一下,如有不正確的地方,歡迎留言,感激不盡~

腳本:

Sub 合並目錄所有工作簿全部工作表()  

Dim MP, MN, AW, Wbn, wn               #定義變量(MP=MyPath,MN=MyName,AW=ActiveWorkbookName,Wbn=WorkBookName,wn=workbooksheet(i)name),但未指定變量類型,這樣不是很規范

Dim Wb As Workbook                        #定義變量Wb為工作簿類型   #Dim Wbn As string,G As Long  #定義變量Wbn為字符型,G為長整型 #Dim Num,ini As Long #定義Num未聲明類型,定義並聲明ini為長整型

Dim i, a, b, d, c, e                               #定義變量,但未指定變量類型,這樣不是很規范

Application.ScreenUpdating = False  #關閉屏幕刷新

MP = ActiveWorkbook.Path               #將當前工作簿(活動工作簿)的路徑賦值給MP

MN = Dir(MP & "\" & "*.xls")               #將當前工作簿(活動工作簿)的路徑加上\*.xls后綴,從而捕獲到的*位置的所有文件名的值,Dir 會返回匹配 pathname 的第一個文件名。若想得到其它匹配 pathname 的文件名,再一次調用 Dir,且不要使用參數。如果已沒有合乎條件的文件,則 Dir 會返回一個零長度字符串 ("")。一旦返回值為零長度字符串,並要再次調用 Dir 時,就必須指定 pathname,否則會產生錯誤。

AW = ActiveWorkbook.Name            #將當前工作簿(活動工作簿)的名字賦值給AW(不帶后綴,只是名字)

Num = 0     #Num=0

e = 1           #ini=0

Do While MN <> ""                           #運行下面的DO while 循環,直到MN值為空值

  If MN <> AW Then                    #如果,MN值不等於AW值,就運行IF到END IF之間的判斷語句

    Set Wb = Workbooks.Open(MP & "\" & MN)                #打開MP\路徑下名為MN變量值的工作簿,並引用(Set的作用)賦給Wb  ##引用賦值如果,對Wb更改了,被引用的也隨着更改了,詳細見下邊PS(3)

    a = a + 1                                                      #對a進行循環累加

    With Workbooks(1).ActiveSheet                                   #對已打開的所有工作簿中的第一個工作簿中的被激活的工作表運用with語句  

      For i = 1 To Sheets.Count                    #在Workbooks(1).ActiveSheet的所有sheet中循環

        If Sheets(i).Range("a1") <> "" Then                #如果Wb工作簿的第i個工作表的A1單元格內容不為空,就進行IF判斷內容,如果為空,跳過IF判斷進入For的下一個循環

          Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy  .Cells(1, 1)  #將wb工作簿中第i個工作表的A1單元格區域擴充為一行,有應用痕跡列數(x)大小的區域,即A1:x1區域,  擴充后區域內的內容復制到Workbooks(1).ActiveSheet的A1位置 

          d = Wb.Sheets(i).UsedRange.Columns.Count     #wb工作簿的第i工作表有應用痕跡的列計數,並賦值給d

          c = Wb.Sheets(i).UsedRange.Rows.Count - 1     #wb工作簿的第i工作表有應用痕跡的行計數,並賦值給c

          wn = Wb.Sheets(i).Name            #wb工作簿的第i個工作表的名字賦值給wn

          .Cells(1, d + 1) = "表名"              #Workbooks(1).ActiveSheet工作表的第1行,第d+1列單元格填充“表名”字符串 
          .Cells(e + 1, d + 1).Resize(c, 1) = MN & wn    #Workbooks(1).ActiveSheet工作表的第e+1行,第d+1列區域擴充為c行,1列區域,並在該區域填充為MN & wn
          e = e + c                   
          Wb.Sheets(i).Range("a2").Resize(c, d).Copy   .Cells(.Range("a1048576").End(xlUp).Row + 1, 1)   #將區域內容,復制到Workbooks(1).ActiveSheet中,每次從Workbooks(1).ActiveSheet的最后一個非空行開始粘貼

        End If

      Next
      Wbn = Wbn & Chr(13) & Wb.Name                                         #將Wbn的值加上空格和Wb工作簿的名稱后賦值給Wbn

      Wb.Close False                    #將Wb工作簿關閉
    End With
  End If
MN = Dir                             #獲得上邊Dir匹配到的下一次文件名;#Dir 會返回匹配 pathname 的第一個文件名。若想得到其它匹配 pathname 的文件名,再一次調用 Dir,且不要使用參數。如果已沒有合乎條件的文件,則 Dir 會返回一個零長度字符串 ("")。一旦返回值為零長度字符串,並要再次調用 Dir 時,就必須指定 pathname,否則會產生錯誤。
Loop
Range("a1").Select                         #選中當前工作簿的第一個單元格
Application.ScreenUpdating = True                  #開啟屏幕刷新
MsgBox "共合並了" & a & "個工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示"        #給出最后提示

End Sub

參考:https://www.jianshu.com/p/f52e6edc2d63

參考:https://zhinan.sogou.com/guide/detail/?id=1610003487  #將模塊加入按鈕(窗體控件)

注意:被合並的文件第一行都得是行標題,而且只保留被合並的第一個文件的第一行,沒有行標題會出錯,缺少數據;被合並的每個文件的A1單元格不能是空單元格,否則整個文件將不會別合並;

 

實例:

1文件是:

2文件是:

 

 

1、2是要合並的文件,3是新建的空文件;要放到一個目錄文件夾下;

打開3文件,打開VBA,粘貼腳本保存,3文件保存為啟用宏的格式文件;

運行宏;

結果展示:

說明:使用的話直接復制粘貼PPS下的腳本即可,把#更換為了符合VBA的注釋格式‘

 

 

PS:

(1)Resize

使用Range對象的Resize屬性調整指定區域的大小,並返回調整大小后的單元格區域,如下面的代碼所示。
Sub Resize()
Sheet4.Range("A1").Resize(3, 3).Select   ‘意思就是把工作表4中的A1單元格擴充為3行3列大小的區域,結果為A1:C3區域
End Sub
代碼解析:
Resize過程使用Range對象的Resize屬性選中A1單元格擴展為三行三列后的區域。
Resize屬性的語法如下:
expression.Resize(RowSize, ColumnSize)
參數expression是必需的,返回要調整大小的Range 對象
參數RowSize是可選的,新區域中的行數。如果省略該參數,則該區域中的行數保持不變。
參數ColumnSize是可選的,新區域中的列數。如果省略該參數。則該區域中的列數保持不變。

參考:http://www.excelpx.com/thread-174857-1-1.html

(2)Dir

這是一個用VBA函數Dir()構造的判斷文件是否存在的自定義函數

Function FileExists(fname) As Boolean ' Returns TRUE if the file exists Dim x As String x = Dir(fname) If x <> "" Then FileExists = True _ Else FileExists = False End Function

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// Dir 函數

返回一個 String,用以表示一個文件名、目錄名或文件夾名稱,它必須與指定的模式或文件屬性、或磁盤卷標相匹配。

語法

Dir[(pathname[, attributes])]

Dir 函數的語法具有以下幾個部分:

部分描述pathname可選參數。用來指定文件名的字符串表達式,可能包含目錄或文件夾、以及驅動器。如果沒有找到 pathname,則會返回零長度字符串 ("")。attributes可選參數。常數或數值表達式,其總和用來指定文件屬性。如果省略,則會返回匹配 pathname 但不包含屬性的文件。

設置值

attributes 參數的設置可為:

常數值描述vbNormal0(缺省) 指定沒有屬性的文件。vbReadOnly1指定無屬性的只讀文件vbHidden2指定無屬性的隱藏文件VbSystem4指定無屬性的系統文件 在Macintosh中不可用。vbVolume8指定卷標文件;如果指定了其它屬性,則忽略vbVolume 在Macintosh中不可用。vbDirectory16指定無屬性文件及其路徑和文件夾。vbAlias64指定的文件名是別名,只在Macintosh上可用。

 

注意 這些常數是由 VBA 所指定的,在程序代碼中的任何位置,可以使用這些常數來替換真正的數值。

說明

在 Microsoft Windows 中, Dir 支持多字符 (*) 和單字符 (?) 的通配符來指定多重文件。

在 Macintosh 中,這些字符作為合法文件名字符並且不能作為通配符來指定多個文件

由於 Macintosh 不支持通配符,使用文件類型指定文件組。可以使用 MacID 函數指定文件類型而不用文件名。比如,下列語句返回當前文件夾中第一個TEXT文件的名稱:

Dir("SomePath", MacID("TEXT"))

為選中文件夾中所有文件,指定一空串:

Dir("")

在 Microsoft Windows 中,如果在Dir函數中使用MacID函數,將產生錯誤。

任何大於256的attribute值都被認為是MacID 函數的值。

在第一次調用 Dir 函數時,必須指定 pathname,否則會產生錯誤。如果也指定了文件屬性,那么就必須包括 pathname

Dir 會返回匹配 pathname 的第一個文件名。若想得到其它匹配 pathname 的文件名,再一次調用 Dir,且不要使用參數。如果已沒有合乎條件的文件,則 Dir 會返回一個零長度字符串 ("")。一旦返回值為零長度字符串,並要再次調用 Dir 時,就必須指定 pathname,否則會產生錯誤。不必訪問到所有匹配當前 pathname 的文件名,就可以改變到一個新的 pathname 上。但是,不能以遞歸方式來調用 Dir 函數。以 vbDirectory 屬性來調用 Dir 不能連續地返回子目錄。

提示 由於文件名並不會以特別的次序來返回,所以可以將文件名存儲在一個數組中,然后再對這個數組排序。

參考:http://club.excelhome.net/thread-121668-1-1.html

(3)Set

VBA中SET是定義一個有屬性和方法的對象

Excel版本參考:2010
1、語法

Set objectvar = {[New] 
objectexpression | Nothing}

Set 語句的語法包含下面部分:

描述

objectvar    
必需的。變量或屬性的名稱,遵循標准變量命名約定。    

New    
可選的。通常在聲明時使用 New,以便可以隱式創建對象。如果 New 與 
Set 一起使用,則將創建該類的一個新實例。如果 
objectvar 包含了一個對象引用,則在賦新值時釋放該引用。不能使用 New 關鍵字來創建任何內部數據類型的新實例,也不能創建從屬對象。    

objectexpression    
必需的。由對象名,所聲明的相同對象類型的其它變量,或者返回相同對象類型的函數或方法所組成的表達式。    

Nothing    
可選的。斷絕 objectvar 與任何指定對象的關聯。若沒有其它變量指向 
objectvar 原來所引用的對象,將其賦為 Nothing 會釋放該對象所關聯的所有系統及內存資源。    
2、說明:

為確保合法,objectvar 必須是與所賦對象相一致的對象類型。

Dim、Private、Public、ReDim以及 Static 語句都只聲明了引用對象的變量。在用 
Set 語句將變量賦為特定對象之前,該變量並沒有引用任何實際的對象。

下面的示例說明了如何使用 Dim 來聲明 Form1 類型的數組。Form1 實際上還沒有實例。然后使用 
Set 將新創建的 Form1 的實例的引用賦給 myChildForms 變量。在 MDI 
應用程序中可以使用這些代碼來創建子窗體。
Dim myChildForms(1 to 4) As Form1
Set myChildForms(1) = New Form1
Set myChildForms(2) = New Form1
Set myChildForms(3) = New Form1
Set myChildForms(4) = New Form1

通常,當使用 Set 將一個對象引用賦給變量時,並不是為該變量創建該對象的一份副本,而是創建該對象的一個引用。可以有多個對象變量引用同一個對象。因為這些變量只是該對象的引用,而不是對象的副本,因此對該對象的任何改動都會反應到所有引用該對象的變量。不過,如果在 
Set 語句中使用 New 關鍵字,那么實際上就會新建一個該對象的實例。
3、Set 語句示例

該示例使用 Set 語句將對象引用賦給變量。假定 YourObject 指向一個具有 Text 
屬性的合法對象。
Dim YourObject, MyObject, MyStr
Set MyObject = YourObject    '對象引用賦值。
'MyObject 和 YourObject 引用同一個對象。
YourObject.Text = "Hello World"    '初始化屬性。
MyStr = MyObject.Text    '返回 "Hello World"。
'脫離關聯。MyObject 不再引用 YourObject。
Set MyObject = Nothing    '釋放該對象。
 參考:https://wenwen.sogou.com/z/q705635956.htm
 
 
PPS:(直接復制粘貼腳本即可,修改了符合VBA的注釋符號)

Sub 合並目錄所有工作簿全部工作表()

Dim MP, MN, AW, Wbn, wn '定義變量(MP=MyPath,MN=MyName,AW=ActiveWorkbookName,Wbn=WorkBookName,wn=workbooksheet(i)name),但未指定變量類型,這樣不是很規范

Dim Wb As Workbook '定義變量Wb為工作簿類型 #Dim Wbn As string,G As Long #定義變量Wbn為字符型,G為長整型 #Dim Num,ini As Long #定義Num未聲明類型,定義並聲明ini為長整型

Dim i, a, b, d, c, e '定義變量,但未指定變量類型,這樣不是很規范

Application.ScreenUpdating = False '關閉屏幕刷新

MP = ActiveWorkbook.Path '將當前工作簿(活動工作簿)的路徑賦值給MP

MN = Dir(MP & "\" & "*.xls") '將當前工作簿(活動工作簿)的路徑加上\*.xls后綴,從而捕獲到的*位置的所有文件名的值,Dir 會返回匹配 pathname 的第一個文件名。若想得到其它匹配 pathname 的文件名,再一次調用 Dir,且不要使用參數。如果已沒有合乎條件的文件,則 Dir 會返回一個零長度字符串 ("")。一旦返回值為零長度字符串,並要再次調用 Dir 時,就必須指定 pathname,否則會產生錯誤。

AW = ActiveWorkbook.Name '將當前工作簿(活動工作簿)的名字賦值給AW(不帶后綴,只是名字)

Num = 0 'Num=0

e = 1 'ini=0

Do While MN <> "" '運行下面的DO while 循環,直到MN值為空值

If MN <> AW Then '如果,MN值不等於AW值,就運行IF到END IF之間的判斷語句

Set Wb = Workbooks.Open(MP & "\" & MN) '打開MP\路徑下名為MN變量值的工作簿,並引用(Set的作用)賦給Wb ##引用賦值如果,對Wb更改了,被引用的也隨着更改了,詳細見下邊PS(3)

a = a + 1 '對a進行循環累加

With Workbooks(1).ActiveSheet '對已打開的所有工作簿中的第一個工作簿中的被激活的工作表運用with語句

For i = 1 To Sheets.Count '在Workbooks(1).ActiveSheet的所有sheet中循環

If Sheets(i).Range("a1") <> "" Then '如果Workbooks(1).ActiveSheet工作簿的第i個工作表的A1單元格內容不為空,就進行IF判斷內容

Wb.Sheets(i).Range("a1").Resize(1, Sheets(i).UsedRange.Columns.Count).Copy .Cells(1, 1) '將wb工作簿中第i個工作表的A1單元格區域擴充為一行,有應用痕跡列數(x)大小的區域,即A1:x1區域, 擴充后區域內的內容復制到Workbooks(1).ActiveSheet的A1位置

d = Wb.Sheets(i).UsedRange.Columns.Count 'wb工作簿的第i工作表有應用痕跡的列計數,並賦值給d

c = Wb.Sheets(i).UsedRange.Rows.Count - 1 'wb工作簿的第i工作表有應用痕跡的行計數,並賦值給c

wn = Wb.Sheets(i).Name 'wb工作簿的第i個工作表的名字賦值給wn

.Cells(1, d + 1) = "表名" 'Workbooks(1).ActiveSheet工作表的第1行,第d+1列單元格填充“表名”字符串
.Cells(e + 1, d + 1).Resize(c, 1) = MN & wn 'Workbooks(1).ActiveSheet工作表的第e+1行,第d+1列區域擴充為c行,1列區域,並在該區域填充為MN & wn
e = e + c
Wb.Sheets(i).Range("a2").Resize(c, d).Copy .Cells(.Range("a1048576").End(xlUp).Row + 1, 1) '將區域內容,復制到Workbooks(1).ActiveSheet中,每次從Workbooks(1).ActiveSheet的最后一個非空行開始粘貼

End If

Next
Wbn = Wbn & Chr(13) & Wb.Name '將Wbn的值加上空格和Wb工作簿的名稱后賦值給Wbn

Wb.Close False '將Wb工作簿關閉
End With
End If
MN = Dir '獲得上邊Dir匹配到的下一次文件名;#Dir 會返回匹配 pathname 的第一個文件名。若想得到其它匹配 pathname 的文件名,再一次調用 Dir,且不要使用參數。如果已沒有合乎條件的文件,則 Dir 會返回一個零長度字符串 ("")。一旦返回值為零長度字符串,並要再次調用 Dir 時,就必須指定 pathname,否則會產生錯誤。
Loop
Range("a1").Select '選中當前工作簿的第一個單元格
Application.ScreenUpdating = True '開啟屏幕刷新
MsgBox "共合並了" & a & "個工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示" '給出最后提示
End Sub

 


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM