向数组添加变量范围vba

我有一系列范围从单独的工作簿复制到单个工作表中。目前我正在通过范围复制/粘贴来完成此操作，但有3个工作簿需要永久更新。我想把它改成一个单一的数组，它可以从每个表中使用范围，将它附加到数组，然后将数组psate到我的表中。向数组添加变量范围vba

当前代码：

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

正如你所看到的，它有点乱，这需要很长的时间来运行（几乎整整一分钟，给定的范围的大小）。

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

感谢

来源

2015-08-20 Dunn

邓恩！

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

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”中的模块中，并且最好在宏执行后在同一实例上不再有其他工作簿。

告诉我，如果你有运气！

来源

2015-08-20 13:49:01 VBAstard

嘿VBAstard;我尝试了你的代码，发现运行只需几分钟，但它在运行时停止了那个excel实例。我希望数组的操作速度比这更快。它虽然工作，谢谢。 – Dunn

我正在审查和审查，并且发现我的ocde的一些小修改，加上它，使它运行得更快，只需几秒钟就可以完成！谢谢！ – Dunn

一些提示（我想放在注释的，但他们时间去解释）：

你不需要复制>>过去，使用Copy [destination]参数这样的伎俩：
```
y.Sheets("TASK").Range("A3:J3000").Copy x.Sheets("TASKS").Range("A2") 
```

你可以找到非常精确的使用范围或者.CurrentRegion或.End(xlUp)技术，样本复制：

一）与CurrentRegion假设你的范围复制是连续的，并开始在Range("A3")：与End(xlUp)假设列A

y.Sheets("TASK").Range("A3").CurrentRegion.Copy x.Sheets("TASKS").Range("A2")

b）您有从A3到最后一行数据的全套：

Dim intLastRowToCopy as integer 
    intLastRowToCopy= y.Sheets("TASK").Cells(Rows.Count, "A").End(xlup).Row 
y.Sheets("TASK").Range("A3:J" & ntLastRowToCopy).copy x.Sheets("TASKS").Range("A2")

来源

2015-08-20 13:26:37

不是复制范围，而是将范围设置为等于新打开的工作簿中的范围。它应该工作得更快。

要找到最后使用的行，请使用此函数。

Function ultimaFilaBlanco(col As String) As Long 

    Dim lastRow As Long 
    With ActiveSheet 
     lastRow = ActiveSheet.Cells(1048576, col).End(xlUp).row 
    End With 

    ultimaFilaBlanco = lastRow 

End Function

这将避免复制空行插入到数组中。来源：How to determinate the last Row used in VBA including black space in the rows

然后对于每个工作簿将范围复制到单独的数组。（这将是更快，然后试图追加数组。（使用ReDim ..））

Sub UpdateTable() 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 'Careful this might prevent the new workbooks from calculating when opened... 

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") 


'set the values from the P6 output sheets to the workbook 

x.Sheets("TASKS").Range("A2:J3000 change this to correct size") = y.Sheets("TASK").Range("A3:J3000") 
x.Sheets("TASKS").Range("A3001:J3300 change this to correct size") = w.Sheets("TASK").Range("A3:J300") 
x.Sheets("TASKS").Range("A3300:J3600 change this to correct size") = z.Sheets("TASK").Range("A3:J300") 

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

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
End Sub

来源

2015-08-20 13:31:38 alphabet5

我推荐了一个alphabet5建议的变体。

在您的主表中，保留对将要复制数据的范围的引用。您可能想要像这样初始化它：

dim dstRange as Range 
set dstRange = x.Sheets("TASKS").Range("A1")

虽然您可以将“A1”更改为您想要开始输出的任何单元格。

接下来，您需要创建一个函数GetUsedRange，它需要一张工作表并返回一个覆盖该工作表中所有数据的范围。最简单的版本是：

Function GetUsedRange(ByRef ws as WorkSheet) as Range 
    Set GetUsedRange = ws.UsedRange 
End Function

注意UsedRange没有被正确的，所以我建议你使用的是KazimierzJawor建议的方法之一，有非常好的口碑。查看this SO Q/A了解更多信息。

现在，而不是复制和粘贴简单地做：

Dim srcRange as Range 
' ... 
Set srcRange = GetUsedRange(y) 
Set dstRange = dstRange.Resize(srcRange.Rows.Count, srcRange.Columns.Count) 
dstRange.Value = srcRange.Value 
Set dstRange = dstRange.Offset(dstRange.Rows.Count,0) 
' ...

希望这有助于！ :)

来源

2015-08-20 14:03:30

向数组添加变量范围vba

回答

相关问题