|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 jjmysjg 于 2024-9-27 22:02 编辑
Sub 多工作簿合并() 'https://club.excelhome.net/thread-1168230-1-1.html?_dsign=e80191a0
Dim HeadRows As Byte, ActiveWB As Workbook, cell As Range
Dim bks As Workbook
Dim fdg As FileDialog
Dim FileName$
Dim p As String
UserForm1.ListBox9.Clear
Set fdg = Application.FileDialog(msoFileDialogFilePicker)
With fdg
.Title = "请选择文件(可以多选)"
.AllowMultiSelect = True 'False表示不能选择多个文件,True表示可以选择多个文件
.Filters.Clear
.Filters.Add "表格文件", "*.xls;*.et;*.xlsx"
FileName = .Show
For i = 1 To .SelectedItems.Count
UserForm1.ListBox9.AddItem (.SelectedItems(i))
Next i
End With
If fdg.SelectedItems.Count = 0 Then Exit Sub
Set fdg = Nothing
On Error Resume Next
Set ActiveWB = ActiveWorkbook '将活动工作簿赋予变量
Set bks = Workbooks.Add
HeadRows = Application.InputBox("请确认待合并工作簿的标题行数,该行将产生在合并工作簿中做为新的标题行:", "标题行", 1, , , , , 1) '让用户指定标题行数,标题不参与合并
If HeadRows < 1 Then Exit Sub '如果标题行小于1则退出程序
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual '计算模式调用手动,从而提速
For j = 0 To UserForm1.ListBox9.ListCount - 1
UserForm1.ListBox9.ListIndex = j
UserForm1.ListBox9.Selected(j) = True
nm = UserForm1.ListBox9.List(UserForm1.ListBox9.ListIndex, 0)
Workbooks.Open FileName:=nm
bm = ActiveWorkbook.Name
ActiveWB.Activate '返回存放合并数据的工作表
bks.Worksheets(1).Activate
If j = 1 Then Intersect(Workbooks(nm).Sheets(1).UsedRange, Workbooks(nm).Sheets(1).Rows("1:" & HeadRows)).Copy bks.Worksheets(1).Cells(1, 1) '如果j=1,那么将标题复制到活动工作表a1
For i = 1 To Workbooks(nm).Sheets.Count '遍历所有工作表,开始合并标题以外的数据
With Workbooks(nm).Sheets(i).UsedRange '引用待合并工作簿中每个工作表的已用区域
If Not IsEmpty(Workbooks(nm).Sheets(i).UsedRange) Then '如果非空表
If .Rows.Count <= HeadRows Then GoTo lines '如果数据行小于等于标题行数则执行下轮循环
Set cell = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) '将活动工作表已用区域的下一行第3个单元格赋予变量
Intersect(.Offset(HeadRows, 0), .Cells).Copy cell '将目标数据除标题外全部复制到cell单元格(此次复制,仅仅需要其格式)
End If
Cells.EntireColumn.AutoFit '自动调整行高列宽
End With
lines:
Next i '合并下一个工作表
Workbooks(nm).Close False '并闭工作簿,且不保存
With UserForm0
.Show 0
.Label2.Width = Int(j / (UserForm1.ListBox9.ListCount - 1) * 282)
.Label3.Caption = bm
.Caption = "正在合并:" & bm
.Label4.Caption = CStr(Int(j / (UserForm1.ListBox9.ListCount - 1) * 100)) + "%"
DoEvents
End With
Next j
MkDir PathStr & "\" & "合并表\"
'bks.SaveAs FileName:=PathStr & "\" & "合并表\" & Left(bm, Len(bm) - 4) & "等表合并" & ".et"
bks.SaveAs FileName:=PathStr & "\" & "合并表\" & Left(bm, Len(bm) - 4) & "等表合并" & ".xls"
bks.Close True
Set bks = Nothing
Unload UserForm0
On Error Resume Next
Application.WindowState = xlMinimized
MsgBox ("请查看合并好的表格!")
Shell "Explorer.exe " & PathStr & "\" & "合并表\", vbMaximizedFocus
UserForm1.Hide
Application.ScreenUpdating = True '恢复屏幕更新
Application.Calculation = xlCalculationAutomatic '恢复自动计算
End Sub
以上代码是站内的代码。怎么建立UserForm1.ListBox9,使代码完成下去。
麻烦老师看看。谢谢!
|
|