Excel VBA如何使用數組打開更多工作簿？

Question

我有一份工作，需要將4個文件合並在一起。 我可以知道如果將來有更多文件要合並，而不是鍵入“打開工作簿”代碼怎么辦。 我應該使用哪種方法？ 並且還符合最低的行合並標准。 下面是我到目前為止嘗試過的代碼

Sub GetFile()
Dim Book1Path As Variant, Book2Path As Variant, Book3Path As Variant, Book4Path As Variant
Dim SourceWB As Workbook, DestWB As Workbook
Dim lRow As Long

Dim ws1, ws2, ws3, ws4 As Worksheet
Dim c3ll1, c3ll2, c3113, c3114, range1, range2, range3, range4 As Range

'## Open both workbook first:

Book1Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 1")
If Book1Path = False Then Exit Sub
Set SourceWB = Workbooks.Open(Book1Path)

Book2Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 2")
If Book2Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book2Path)

Book3Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 3")
If Book3Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book3Path)

Book4Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 4")
If Book4Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book4Path)

'Copy.
With SourceWB.Sheets("Report")
   lRow = .Cells(Rows.Count, 1).End(xlUp).Row
   .Range("A2:F" & lRow).Copy
End With

'Active Merge Workbook
ThisWorkbook.Activate

'Paste.
Columns("A").Find("", Cells(Rows.Count, "A")).Select
Selection.PasteSpecial

'Active CWPI Topic 1 Assessment Workbook
SourceWB.Activate

'Copy.
With SourceWB.Sheets("Report")
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("G2:G" & lRow).Copy
End With

'Active Merge Workbook
ThisWorkbook.Activate

'Paste.
Columns("G").Find("", Cells(Rows.Count, "G")).Select
Selection.PasteSpecial

Set ws1 = SourceWB.Sheets("Report")
Set ws2 = DestWB.Sheets("Report")
Set ws3 = DestWB.Sheets("Report")
Set ws4 = DestWB.Sheets("Report")

lastrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set range2 = ws2.Range("A2:A" & lastrow2)
lastrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set range1 = ws1.Range("A2:A" & lastrow1)
For Each c3ll2 In range2

a = 0
activerow2 = c3ll2.Row
For Each c3ll1 In range1
    If c3ll1.Value = c3ll2.Value Then
        activerow1 = c3ll1.Row
        Cells(activerow1, "H") = ws2.Cells(activerow2, 3)
        Cells(activerow1, "I") = ws2.Cells(activerow2, 4)
        Cells(activerow1, "J") = ws2.Cells(activerow2, 5)
        Cells(activerow1, "K") = ws2.Cells(activerow2, 6)
        Cells(activerow1, "L") = ws2.Cells(activerow2, 7)
        a = 1                                                   'Username is found
        Exit For
        End If
Next c3ll1
If a = 0 Then                       'If Username is not found print at end
    lastrow1 = lastrow1 + 1
    Cells(lastrow1, "A") = ws2.Cells(activerow2, 1)
    Cells(lastrow1, "B") = ws2.Cells(activerow2, 2)
    Cells(lastrow1, "H") = ws2.Cells(activerow2, 3)
    Cells(lastrow1, "I") = ws2.Cells(activerow2, 4)
    Cells(lastrow1, "J") = ws2.Cells(activerow2, 5)
    Cells(lastrow1, "K") = ws2.Cells(activerow2, 6)
    Cells(lastrow1, "L") = ws2.Cells(activerow2, 7)
End If
Next c3ll2

'Columns Width Autofit
ActiveSheet.Columns.AutoFit

With Application
      Cells(.CountA(Columns("A:A")) + 1, 1).Select
      .ScreenUpdating = True
      .DisplayAlerts = False
      SourceWB.Close
      DestWB.Close
End With

End Sub

Answer 1

所以...您是否正在尋找一個循環來輕松地打開更多工作簿？ 現在，您沒有像想象中那樣打開3個版本的DestWB。 而是每次調用時都覆蓋DestWB。

Set DestWB = Workbooks.Open(BookXPath)

我將用以下內容替換三個打開路徑的塊，檢查路徑，然后打開到工作簿DestWB的路徑：

'Create an array of paths, and a corresponding array of workbooks
Dim paths() As String, wbs() as Workbook
ReDim paths(3)
'ReDim wbs to the same as path so its easier to adjust in the future
ReDim wbs(UBound(paths))
'Set your paths, then loop through them to assign your workbooks
Dim x as Integer
For x = 1 To UBound(paths)
     paths(x) = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter " + CStr(x))
     If paths(x) = "False" Then
          Exit Sub
     End If
     Set wbs(x) = Workbooks.Open(paths(x))
Next x

您可以使用相同的循環方法來執行此宏中的其他任務。 您還可以通過將其設置為變量來消除對ThisWorkbook的所有激活。

Dim thisWB as Workbook
Set thisWB = ThisWorkbook

反過來，這將使您清理此代碼...

Columns("A").Find("", Cells(Rows.Count, "A")).Select
Selection.PasteSpecial

進入這段代碼...

thisWB.Sheets("SOMESHEET").Columns("A").Find("", Cells(Rows.Count, "A")).PasteSpecial

通常，應避免選擇和選擇。 在stackoverflow和Google周圍搜索時，有很多示例說明了這兩個循環並消除了.Select和Selection。