excel - 如何将多个文件加载到我的 Excel 工具中？

Question

我想让我的工具能够选择多个文件并进行加载，而无需为每个文件经历打开文件对话框。这是我的初始编码:

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

我可以知道如何增强此编码以便能够选择多个文件并执行加载吗？

Answer 1

我喜欢使用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