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。