Arrays Excel VBA如何使用数组打开更多工作簿？

我有一个工作，我需要合并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

---

所以…你在寻找一个循环，以一种简单的方式打开更多的工作簿？现在，您并没有像您想象的那样打开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

您可以使用相同的循环方法来执行此宏中的其他任务。您还可以通过将此工作簿设置为变量来消除对此工作簿的所有激活

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

在这个代码中

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

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

一般来说，应避免选择和选择。搜索stackoverflow和Google，有很多关于循环和消除的例子。选择和选择