注册 登录
编程论坛 VB6论坛

合并同一个文件夹中多个相同结构的EXCEL表合并在一个EXCEL表中代码不明白,请高手指教

sylknb 发布于 2016-11-27 14:10, 4806 次点击
下面的合并代码。VBA我是新手不懂,哪位高手能否逐行注释一下好吗?多谢了

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 +2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

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

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

Wb.Close False

End With

End If

MyName = Dir

Loop

Range("A1").Select

Application.ScreenUpdating = True

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

End Sub
4 回复
#2
xiangyue05102016-11-27 15:14
学习VB或者VBA的过程就是学习别人的代码,并转为己用。如果你连这个过程都想要假借别人之手,我认为你不需要学习VB了
#3
sylknb2016-11-27 20:28
班主:
不懂才向人请教。
#4
xiangyue05102016-11-27 22:06
你可以说哪一句不明白来问,每一句都要别人给你标注,这个不是学习。
懒还如此的理直气壮,无语
#5
sylknb2016-11-29 09:32
标有红色的代码能否解释好吗?

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 +2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

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

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

Wb.Close False

End With

End If

MyName = Dir

Loop

Range("A1").Select

Application.ScreenUpdating = True

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

End Sub
1