|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 pyxzx 于 2021-12-29 11:25 编辑
在网上找到一个合并文件夹下所有工作簿的代码
1.求高手加个注释,太高深看不懂
2.这个代码有一个错误,它会多复制一个表格,最上面和最下面的一样(未验证中间是否错误)该怎么修改会正确?
3.如果文件夹下有多个扩展名的文件,该如何修改?(比如有xls的,有xlsx的,有xlsm的)
求高手帮忙解答一下,谢谢
- Dim x As Integer '定义个一公有变量记录复制行数
- '复制多个Excel文件中的内容到一个里
- Sub combine()
- x = 1
- Dim folder As String
- Dim count As Integer
- folder = ChooseFolder()
- 'count = combineFiles(folder, 'xls')
- count = count + combineFiles(folder, "xlsm")
- MsgBox (" succeed ")
- End Sub
- Function combineFiles(folder, appendix)
- Dim MyFile As String
- Dim s As String
- Dim count, n, copiedlines As Integer
- MyFile = Dir(folder & "\*." & appendix)
- count = count + 1
- n = 2
- Do While MyFile <> ""
- copiedlines = CopyFile(folder & "" & MyFile, 2, n)
- If copiedlines > 0 Then
- n = n + copiedlines
- count = count + 1
- End If
- MyFile = Dir
- Loop
- combineFiles = count
- End Function
- '复制数据
- Function CopyFile(filename, srcStartLine, dstStartLine)
- Dim book As Workbook
- Dim sheet As Worksheet
- Dim rc As Integer
- CopyFile = 0
- If filename = (ThisWorkbook.Path & "" & ThisWorkbook.Name) Then
- Exit Function
- End If
- Set book = Workbooks.Open(filename)
- ThisWorkbook.Activate
- For j = 1 To book.Sheets.count
- book.Sheets(j).UsedRange.Copy Cells(x, 1)
- With ActiveSheet.Cells.Find("*", Cells(1, 1), -4163, 1, 1, 2).MergeArea '通用判断最后一行
- Rows(.Row + .Rows.count - 1).Select
- x = Selection.Row + Selection.Rows.count - 1
- End With
- x = x + 1
- Next j
- book.Close
- End Function
- '选择文件夹
- Function ChooseFolder() As String
- Dim dlgOpen As FileDialog
- Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
- With dlgOpen
- If .Show = -1 Then
- ChooseFolder = .SelectedItems(1)
- End If
- End With
- Set dlgOpen = Nothing
- End Function
复制代码 |
|