如何加载多个文件到我的Excel工具？
我想使我的工具能够select多个文件，并进行加载，而无需通过每个文件的打开文件对话框。 这是我的初始编码：
Sub Step_One() Dim vFile As Variant Dim sInputFileName As String Dim sInputTabName As String Dim sInputWorkbookName As String Dim wb As Workbook Dim wbCurrent As Workbook Set wbCurrent = ActiveWorkbook 'Showing Excel Open Dialog Form vFile = Application.GetOpenFilename("Excel Files (*.xls*)," & _ "*.xls*", 1, "Select Excel File", "Open", False) 'If Cancel then exit If TypeName(vFile) = "Boolean" Then Exit Sub End If 'Retrieve Filename sInputFileName = Dir(vFile, vbDirectory) sInputTabName = Dir(vFile, vbDirectory) sInputWorkbookName = Dir(vFile, vbDirectory) Application.DisplayAlerts = False 'Open selected file Workbooks.Open vFile Application.DisplayAlerts = False bFound = False For Each wb In Application.Workbooks If InStr(UCase(wb.Name), UCase(sInputFileName)) > 0 Then bFound = True Exit For End If Next wb If Not bFound Then Set wb = Application.Workbooks.Open(sInputWorkbookName) bFound = False For Each shtData2 In wb.Sheets If UCase(shtData2.Name) = UCase("Tank Super") Then bFound = True Exit For End If Next shtData2 If Not bFound Then MsgBox "Worksheet missing", vbInformation + vbOKOnly Set shtData2 = Nothing Exit Sub End If bFound = False For Each shtMain In wbCurrent.Sheets If UCase(shtMain.Name) = UCase("Daily Comparison") Then bFound = True Exit For End If Next shtMain If Not bFound Then MsgBox "Worksheet missing", vbInformation + vbOKOnly Set shtMain = Nothing Exit Sub End If For Each sh In wb.Worksheets If sh.Name Like "Tank Diesel" _ Or sh.Name Like "Tank V-Power" _ Or sh.Name Like "Tank Super" Then sh.Copy After:=wbCurrent.Sheets("Daily Comparison") Next wb.Close Set wb = Nothing Worksheets("Daily Comparison").Unprotect "superman" Sheets("Daily Comparison").Select Range("A1").Select If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If Application.DisplayAlerts = False For Each sh In wbCurrent.Sheets If sh.Name Like "Tank Diesel" Then If Sheets("Tank Diesel").AutoFilterMode Then 'autofilter is 'on' On Error Resume Next 'turn off error reporting Sheets("Tank Diesel").ShowAllData On Error GoTo 0 'turn error reporting back on End If Dim dys As Long dys = Day(Application.EoMonth(DateValue(Sheets("Tank Diesel").Cells(1, 5).Value & " 1, " & Year(Date)), 0)) Sheets("Daily Comparison").Cells(Rows.Count, "K").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(1, 2).Value Sheets("Daily Comparison").Cells(Rows.Count, "L").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(1, 8).Value Sheets("Daily Comparison").Cells(Rows.Count, "M").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(5, 1).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "O").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(5, 2).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "Q").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(5, 3).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "V").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(5, 6).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "AA").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(5, 8).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "AC").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Diesel").Cells(5, 10).Resize(dys, 1).Value Sheets("Tank Diesel").Delete ElseIf sh.Name Like "Tank V-Power" Then If Sheets("Tank V-Power").AutoFilterMode Then 'autofilter is 'on' On Error Resume Next 'turn off error reporting Sheets("Tank V-Power").ShowAllData On Error GoTo 0 'turn error reporting back on End If dys = Day(Application.EoMonth(DateValue(Sheets("Tank V-Power").Cells(1, 5).Value & " 1, " & Year(Date)), 0)) Sheets("Daily Comparison").Cells(Rows.Count, "K").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(1, 2).Value Sheets("Daily Comparison").Cells(Rows.Count, "L").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(1, 8).Value Sheets("Daily Comparison").Cells(Rows.Count, "M").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(5, 1).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "O").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(5, 2).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "Q").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(5, 3).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "V").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(5, 6).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "AA").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(5, 8).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "AC").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank V-Power").Cells(5, 10).Resize(dys, 1).Value Sheets("Tank V-Power").Delete ElseIf sh.Name Like "Tank Super" Then If Sheets("Tank Super").AutoFilterMode Then 'autofilter is 'on' On Error Resume Next 'turn off error reporting Sheets("Tank Super").ShowAllData On Error GoTo 0 'turn error reporting back on End If dys = Day(Application.EoMonth(DateValue(Sheets("Tank Super").Cells(1, 5).Value & " 1, " & Year(Date)), 0)) Sheets("Daily Comparison").Cells(Rows.Count, "K").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(1, 2).Value Sheets("Daily Comparison").Cells(Rows.Count, "L").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(1, 8).Value Sheets("Daily Comparison").Cells(Rows.Count, "M").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(5, 1).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "O").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(5, 2).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "Q").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(5, 3).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "V").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(5, 6).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "AA").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(5, 8).Resize(dys, 1).Value Sheets("Daily Comparison").Cells(Rows.Count, "AC").End(xlUp).Offset(1, 0).Resize(dys, 1) = Sheets("Tank Super").Cells(5, 10).Resize(dys, 1).Value Sheets("Tank Super").Delete Else SheetExists = False End If Next sh Sheets("Daily Comparison").Select Range("A1").Select Worksheets("Daily Comparison").Protect "superman", AllowFiltering:=True wbCurrent.Save Application.DisplayAlerts = False MsgBox "Step 1: " & sInputTabName & " is imported succesfully!", vbInformation + vbOKOnly End Sub 我可以知道如何增强这个编码，以便能够select多个文件并执行加载？
另一种方法是将MultiSelect参数设置为TRUE。
vfile = Application.GetOpenFilename("Excel Files (*.xls*)" & _ ",*.xls*", 1, "Select Excel File", "Open", True) If Not IsArray(vfile) Then Exit Sub For i = LBound(vfile) To UBound(vfile) Workbooks.Open vfile(i) 'other cool stuff go here Next
请注意，应该像你所做的那样将vfile声明为Variant 。
我喜欢使用FileDialogs，我认为它更灵活。 这里有一些你应该可以修改和使用的代码：
Private Sub PickExcelFiles() Dim fdFileDialog As FileDialog Dim SelectedItemsCount As Long Dim i As Long Set fdFileDialog = Application.FileDialog(msoFileDialogOpen) With fdFileDialog .Filters.Clear .Filters.Add "XLS* Files (*.xls*)", "*.xls*" .FilterIndex = 1 .InitialView = msoFileDialogViewDetails .Title = "Select SQL Files" .ButtonName = "Select" .AllowMultiSelect = True .Show If .SelectedItems.Count = 0 Then Exit Sub End If SelectedItemsCount = .SelectedItems.Count For i = 1 To SelectedItemsCount Workbooks.Open .SelectedItems(i) Next i End With End Sub