以高效方式将多区域范围的值复制到另一个工作表

时间:2014-09-08 22:41:00

标签: excel vba excel-vba

我在Excel中有一个命名范围(bufferFields),如下所示:

=Panel!$G$3:$G$24;Panel!$J$2:$J$20;Panel!$M$2:$M$14;Panel!$C$14;Panel!$M$15:$M$26

将多个区域范围内的所有67个单元格的值放在另一个工作表(历史记录)中的高效方法是什么,与它们在范围内定义的顺序相同,这样我就可以保留一个记录我在vba代码上进行的每次迭代计算的Panel表的状态?

对于我的算法的每次运行,我想将所有bufferFields值记录到History上的不同行。

这是我到目前为止所做的,并且它按预期工作,但我认为性能受到原始范围内所有单元格循环的影响(而不是使用方法或vba函数将其全部集中在一个去):

dim c as range, column as integer, row as integer

column = 1
row = 1 ' this is controlled in another portion of the sub


For Each c In Range("bufferFields").Cells
    Sheets("History").Cells(row, column) = c.Value
    column = column + 1
Next

2 个答案:

答案 0 :(得分:2)

将范围读入数组,然后构造一个新数组以写入第二个工作表,将比使用单元格中的随机值逐个单元地运行快30倍。此外,您应该关闭ScreenUpdating,计算,如果您使用的是事件宏,也可以禁用它们。

当您将多个区域范围读入数组时,您必须逐个区域进行操作;并且您还需要进行测试以确保读入的区域是一个单元格或多个单元格。这是一些标本代码。请注意,我必须使用History_作为工作表的名称,因为在美国 - 英文版的Excel,历史是一个保留字。

Option Explicit
Sub CopyBufferFields()
    Dim I As Long
    Dim J As Long, K As Long, L As Long
    Dim vSrc As Variant, vRes As Variant
Application.ScreenUpdating = False
Dim lRW As Long
   lRW = 1 'Row number to be set
With [bufferfields]
    ReDim vRes(1 To 1, 1 To .Count)
    For I = 1 To .Areas.Count
        vSrc = .Areas(I)
        If IsArray(vSrc) Then
        For J = 1 To UBound(vSrc, 1)
            For K = 1 To UBound(vSrc, 2)
                L = L + 1
                vRes(1, L) = vSrc(J, K)
            Next K
        Next J
        Else
            L = L + 1
            vRes(1, L) = vSrc
        End If
    Next I
End With
Worksheets("History_").Cells(lRW, 1).Resize(columnsize:=UBound(vRes, 2)) = vRes

Application.ScreenUpdating = True
End Sub

答案 1 :(得分:0)

使用区域并复制它们:

Row = 1
Col = 1
For Each R In Range("bufferFields").Areas
    R.Copy Destination:=Sheets("History").Cells(Row, Col)
    Row = Row + R.Rows.Count
Next

这会将所有值都放在一列中。 如果您希望彼此相邻的所有列都使用

    Col = Col + 1 ' instead of Row = Row + R.Rows.Count

如果您真的想要包含所有值的ONE ROW,请使用(警告:此代码使用可能会干扰用户的复制粘贴):

Row = 1
Col = 1
For Each R In Range("bufferFields").Areas
    R.Copy
    Sheets("History").Cells(Row, Col).PasteSpecial xlPasteAll, Transpose:=True
    Col = Col + R.Rows.Count
Next

如果工作表中有很多公式,那么通过添加

可以最大限度地提高代码
Application.Calculation = xlCalculationManual 

在您的代码和

之前
Application.Calculation = xlCalculationAutomatic
复制代码后

。如果工作簿很大,这可能会加速。