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

Excel VBA How to open more workbook using array?

提问by user3006276

i have a job which i need to merge 4 files together. May i know what if i have more files in coming future to merge, instead keying the "open workbook"code. What kind of method should i use? and yet meet the lowest line merge criteria as well. Below is the code i have attempt so far

我有一份工作需要将 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

回答by DeanBDean

So...you're looking for a loop to open up more workbooks in an easy way? Right now, you are not opening 3 versions of DestWB like you think you are. You are instead overwriting DestWB each time you call...

所以......您正在寻找一个循环来以简单的方式打开更多工作簿？现在，您并没有像您想象的那样打开 3 个版本的 DestWB。每次调用时，您都会覆盖 DestWB...

Set DestWB = Workbooks.Open(BookXPath)

I would replace your three blocks that open the path, check the path, and then open the path to the workbook DestWB with the following:

我将替换您打开路径的三个块，检查路径，然后使用以下内容打开工作簿 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

You can use the same loop methodology to do the other tasks in this macro. You can also eliminate all your activating of the ThisWorkbook by setting it as a variable.

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

Dim thisWB as Workbook
Set thisWB = ThisWorkbook

This will in turn let you clean up this code...

这将反过来让你清理这段代码......

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

Into this code...

进入这段代码...

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

In general .Select and Selection should be avoided. Search around stackoverflow and Google, there are plenty of examples for both loops and eliminating .Select and Selection.

一般来说，应该避免 .Select 和 Selection 。在 stackoverflow 和 Google 周围搜索，有很多关于循环和消除 .Select 和 Selection 的示例。