Question

很简单，我想知道将单元格值从一个工作表复制到另一个工作表的最快方法是什么。

通常，我会按列和/或行循环遍历单元格，并使用如下行：

Worksheets("Sheet1").Cells(i,j).Value = Worksheets("Sheet1").Cells(y,z).Value

在我的范围不是连续行/列的其他情况下（例如，我想避免覆盖已经包含数据的单元格）我会在循环内部有一个条件，或者我将填充一个数组（s）with row＆amp;我希望循环的列号，然后遍历数组元素。例如：

Worksheets("Sheet1").Cells(row1(i),col1(j)).Value = Worksheets("Sheet2").Cells(row2(y),col2(z)).Value

使用我要复制的单元格和目标单元格定义范围会更快，然后执行Range.Copy和Range.Paste操作吗？是否可以使用数组定义范围而无需循环遍历它？或者，通过循环数组来定义范围，然后复制粘贴范围而不是通过循环等于单元格值，它会更快吗？

我觉得根本不可能复制和粘贴这样的范围（即它们需要通过矩形阵列连续的单元格并粘贴到相同大小的矩形阵列中）。话虽如此，我认为可以将两个范围的元素等同，而不会遍历每个单元格并使值等于。

Answer 1

对于矩形块：

Sub qwerty()
    Dim r1 As Range, r2 As Range

    Set r1 = Sheets("Sheet1").Range("A1:Z1000")
    Set r2 = Sheets("Sheet2").Range("A1")

    r1.Copy r2
End Sub

很快。

对于活动表上的非连续范围，我会使用循环：

Sub qwerty2()
    Dim r1 As Range, r2 As Range

    For Each r1 In Selection
        r1.Copy Sheets("Sheet2").Range(r1.Address)
    Next r1
End Sub

修改＃1：

范围到范围方法甚至不需要中间数组：

Sub ytrewq() Dim r1 As Range, r2 As Range Set r1 = Sheets("Sheet1").Range("A1:Z1000") Set r2 = Sheets("Sheet2").Range("A1:Z1000") r2 = r1 End Sub

这与以下内容完全相同：

ary=r1.Value r2.value=ary

除了ary是隐含的。

Answer 2

我尝试了4种方法，并且显而易见（对我来说）：

Option Explicit

Sub testCopy_speed()

Dim R1 As Range, r2 As Range
Set R1 = ThisWorkbook.Sheets(1).Range("A1:Z1000")
Set r2 = ThisWorkbook.Sheets(2).Range("A1:Z1000")

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With


Dim t As Single
Dim i&, data(), Rg As Range
ReDim data(R1.Rows.Count, R1.Columns.Count)

For Each Rg In R1.Cells: Rg = Rnd()*100: Next Rg

R1.ClearContents
R1.ClearFormats

r2.ClearContents
r2.ClearFormats


'For Each Rg In R1.Cells: 'if you do this too often , you'll get an error
'    With Rg
'        .Value2 = Rnd() * 100
'        .Interior.Color = Rnd() * 65535
'        '.Font.Color = Rnd() * 65535
'    End With
'Next Rg


t = Timer

For i = 1 To 100
    'r2.Value2 = R1.Value2 '1,71 sec
    'R1.Copy r2 '0.74 sec  <<<<   Winer , but see NOTE.
    'data = R1.Value2: r2.Value2 = data '1.78 sec
    'For Each Rg In R1.Cells: r2.Cells(Rg.Row, Rg.Column).Value2 = Rg.Value2: Next Rg '54 seconds !!
Next i

Erase data
Set R1 = Nothing
Set r2 = Nothing
Set Rg = Nothing

Debug.Print Timer - t

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

注意：我对这些结果并不满意所以我测试了更多，如果R1包含许多不同的格式，R1.copy R2方法将需要10秒。所以在这种情况下R2=R1会更好（快6倍）。

Answer 3

我发现这个线程正在寻求加速将72个单元格从一个工作表传输到另一个工作表（数据存储表到数据输入表）。

我的代码看起来像这样：

t(7)=timer*1000
Dim datasht As Worksheet
Set datasht = WB2.Worksheets("Equipment-Data")
With WB2.Worksheets("Equipment")
 .Range("D2").Value = datasht.Cells(datarow, 1)
 .Range("D3").Value = datasht.Cells(datarow, 2)
 .Range("I7").Value = datasht.Cells(datarow, 3)
 ...
 t(8)=timer*1000     
 ...
 .Range("G51").Value = datasht.Cells(datarow,72)
End With
t(9)=timer*1000

手动输入的代码，请原谅任何拼写错误。

从t（7）到t（9）需要大约600ms。顺便说一下，我使用 Application.WorksheetFunction.Vlookup 72次切换到确定数据表中的相应行，只有一个 datarow = .Cells.Find（...）并且它在执行时间中没有产生可察觉的影响。

我在中间添加了一个计时器，并确认每一半都需要大约300毫秒才有意义但是要确保没有特定的单元格导致问题。

由于大多数时间只有1个或少数几个单元格发生了变化，因此我在写入之前添加了一个检查以查看数据是否有所不同，并且Sub现在在大约4ms内运行。

If .Range("D2").Formula <> datasht.Cells(datarow, 1).Formula Then .Range("D2").Value = datasht.Cells(datarow, 1)

Answer 4

切勿尝试遍历包含多行的大数据集。尽量按列复制范围。

Dim lRow As Long
lRow = Sheets("Source").Range("A100000").End(xlUp).Row
Sheets("Target").Range("A1:D" & lRow).Value = 
Sheets("Source").Range("G1:J" & lRow).Value

在Excel VBA中复制大量值的最快方法

4 个答案: