excel-合并多个Excel文件--VBA合并当前目录下所有Excel工作簿中的所有工作表

版本1:

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后缀,从而捕获到的*位置的所有文件名的值,都赋值给MN,即MN是个数组

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变量值的工作簿,并赋给Wb  ##Set起到了什么作用???

    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
Loop
Range("a1").Select                         #选中当前工作簿的第一个单元格
Application.ScreenUpdating = True                  #开启屏幕刷新
MsgBox "共合并了" & a & "个工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示"        #给出最后提示
End Sub

猜你喜欢

转载自www.cnblogs.com/Formulate0303/p/10876861.html