vba - 将变量范围附加到数组vba

Question

我有一系列范围，正在从单独的工作簿复制到一张工作表中。目前我正在通过范围复制/粘贴来完成此操作，但是对于 3 个工作簿，需要永远更新。我想将其更改为单个数组，该数组可以从每个工作表中获取使用的范围，将其附加到数组，然后将数组插入到我的表中。

当前代码:

Sub UpdateTable()
Dim icounter As Long
Dim x As Workbook 'The book we're in
Dim y As Workbook 'The data from P6
Dim z As Workbook
Dim w As Workbook

Set x = ThisWorkbook

Set y = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6011-Activities.xls")
Set z = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6006-Activities.xls")
Set w = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\MCR4-Activities.xls")


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'Copy-paste the values from the P6 output sheets to the workbook
y.Sheets("TASK").Range("A3:J3000").Copy

x.Sheets("TASKS").Range("A2").PasteSpecial

Application.CutCopyMode = False

z.Sheets("TASK").Range("A3:J300").Copy

x.Sheets("TASKS").Range("A3001").PasteSpecial

Application.CutCopyMode = False

w.Sheets("TASK").Range("A3:J300").Copy

x.Sheets("TASKS").Range("A3300").PasteSpecial

Application.CutCopyMode = False

'Close the output sheets
y.Close
z.Close
w.Close



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

正如您所看到的，它有点困惑，并且需要很长时间才能运行(考虑到范围的大小，几乎一整分钟)。

我选择这么大范围的原因是因为我不知道每个工作表中将出现多少项目(行)。列将始终保持不变，但行可能会发生变化。

谢谢

Answer 1

邓恩!

如果你想要的是效率，我认为有更好的方法，优化你编写的代码，只复制重要的数据；尝试这个代码，它很可能会减少您的处理时间:

Sub UpdateTable()
Dim icounter As Long
Dim x As Workbook 'The book we're in
Dim y As Workbook 'The data from P6
Dim z As Workbook
Dim w As Workbook

Dim WB As Workbook

Set x = ThisWorkbook

Set y = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6011-Activities.xls")
Set z = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\6006-Activities.xls")
Set w = Workbooks.Open("W:\AOPS\Scheduling\Allan Dunn\P6 Output Folder\MCR4-Activities.xls")


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'Copy-paste the values from the P6 output sheets to the workbook

For Each WB In Application.Workbooks

    WB.Activate

    If WB.Name <> x.Name Then

        If WB.Name = y.Name Or _
           WB.Name = z.Name Or _
           WB.Name = w.Name Then

            WB.Sheets("TASK").Range(Cells(3, 1), Cells(3, 1).SpecialCells(xlLastCell)).Copy
            x.Activate
            x.Sheets("TASKS").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
       Application.CutCopyMode = False

      End If

    End If

Next

'Close the output sheets
y.Close
z.Close
w.Close



Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub

我尝试了大约 3000 行，运行时间不到 10 秒；只要确保将此宏粘贴到工作簿“x”内的模块中，并且执行该宏后，最好在同一实例上没有其他工作簿。

告诉我你是否幸运!