用于合并表格的EXCEl vba代码解释

以下是对网上大牛给出的vba源码,经过查阅资料和实践后给出的逻辑分析:

=======================================================

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName ‘定义这三个变量

Dim Wb As Workbook, WbN As String ’定义Wb为工作表,WbN为字符串变量

Dim G As Long ‘定义G为长整型变量

Dim Num As Long ’定义Num为长整型变量

Dim BOX As String ‘定义BOX为字符串变量

Application.ScreenUpdating = False ’关闭屏幕更新

MyPath = ActiveWorkbook.Path ‘赋值MyPath为表格文件路径

MyName = Dir(MyPath & "\" & "*.xls") ’遍历文件夹里所有文件名赋值给MyName

AWbName = ActiveWorkbook.Name ‘活动工作表的名称赋值给AWbName

Num = 0 ’长整型变量Num为0

Do While MyName "" ‘判断条件是否满足,满足就进入MyName的循环

If MyName AWbNameThen‘判断除了活动工作表以外的表格则

Set Wb = Workbooks.Open(MyPath & "\" & MyName) ’

Num = Num + 1 ‘计数+1

With Workbooks(1).ActiveSheet

.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) ’确定从A65536范围内以上的最后一行非空单元格+2,1,先复制文件名

For G = 1 To Sheets.Count ‘从第一个表到当前工作簿中全部工作表的总数

Wb.Sheets(G).UsedRange.Copy.Cells(.Range("A65536").End(xlUp).Row + 1, 1)

‘将该工作表可见范围内的单元格内容复制到最后一行非空单元格+1

Next

WbN = WbN & Chr(13) & Wb.Name ’回车,把打开的工作簿名称累计起来存入到WbN字符串中

Wb.Close False ‘关闭该workbook并不保存,True则为保存

End With ’with end with语句可以省略运行对象,直接.Cells()

End If

MyName = Dir '第二次调用 Dir 函数,但不带任何参数,则函数将返回同一目录下的下一个 *.xls 文件

Loop

Range("A1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"

End Sub

=======================================================

下面为适应数据处理需要,调整表格的第一列为表格文件名称,所作的修改版:

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & "\" & "*.xls")

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName ""

If MyName AWbName Then

Set Wb = Workbooks.Open(MyPath & "\" & MyName)

Num = Num + 1

With Workbooks(1).ActiveSheet

.Cells(.Range("B65536").End(xlUp).Row + 1, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To 1

Wb.Sheets(G).Range("A2:G999").Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 2)

Next

WbN = WbN & Chr(13) & Wb.Name

Wb.Close False

.Range(.Cells([A65536].End(xlUp).Row + 1, 1), .Cells([B65536].End(xlUp).Row, 1)) = Left(MyName, Len(MyName) - 4)

‘注:该行代码不能放在关闭表格前的循环内

End With

End If

MyName = Dir

Loop

Range("A1").Select

Application.ScreenUpdating = False

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"

End Sub

  • 发表于:
  • 原文链接https://kuaibao.qq.com/s/20180613G0037T00?refer=cp_1026
  • 腾讯「云+社区」是腾讯内容开放平台帐号(企鹅号)传播渠道之一,根据《腾讯内容开放平台服务协议》转载发布内容。

扫码关注云+社区

领取腾讯云代金券