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

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

一般来说,我将按列和/或行循环遍历单元格,并使用如下行:

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

在其他情况下,我的范围不是连续的行/列(例如,我想避免覆盖已经包含数据的单元格),我要么在循环内有一个条件,要么用行列填充数组我想循环的数字,然后遍历数组元素。 例如:

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

使用我想要复制的单元格和目标单元格来定义范围会更快吗,然后执行Range.CopyRange.Paste操作? 有没有可能使用数组定义一个范围,而不必循环呢? 或者是否会更快地循环通过一个数组定义一个范围,然后复制粘贴的范围,而不是通过循环等同的单元格值?

我觉得可能无法像这样复制和粘贴范围(即它们需要通过矩形数组连续单元格并粘贴到相同大小的矩形数组中)。 这就是说,我认为有可能将两个范围的元素等同起来,而不用循环遍历每个单元格并且等同于这些值。

对于一个矩形块:

 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:

range-to-range方法甚至不需要中间数组:

 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是隐含的。

我尝试了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 

注意:我对这些结果并不满意,所以我testing了一些,如果R1包含许多不同的格式, R1.copy R2方法将需要10秒。 所以在这种情况下, R2=R1会更好(快6倍)。

我发现这个线程正在加速将72个单元格从一个单元格转移到另一个单元格(一个数据存储表单到一个数据input单)。

我的代码看起来像这样:

 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毫秒,这是有道理的,但要确保没有特定的单元格造成问题。

由于大多数时间只有一个或一小撮的单元格已经改变,我添加了一个检查,看在写入之前数据是否不同,现在小组现在运行在大约4ms。

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