加快复制/粘贴范围

Question

在一张纸上，我有从A列到L列的数据行。

我有一个宏，给定用户输入，它可以搜索行，然后将其复制并粘贴到其他（最初为空白）工作表中。每次复制和粘贴后，搜索将继续。不幸的是，有时这涉及复制和粘贴500行。 Excel在大约400行处开始挣扎，速度非常慢，并且经常崩溃。

我已经读过Slow VBA macro writing in cells，但不确定是否适用。

将创建由我的搜索产生的行号的集合，然后遍历并复制和粘贴相应的行比“被发现”后立即复制和粘贴该行要快（这是当前的方式）有效）？

我不会这么想的。所以我的问题是，我可以加快复制和粘贴大量行的vba过程吗？

编辑：

nextblankrow=worksheets("findings").Range("A"&rows.count).End(xlup).row+1
Sheets("data").cells(J,1).EntireRow.copy sheets("findings").cells(nextblankrow,1)

因此，在上面的代码中，第一行在“查找”工作表中找到下一个空行。然后，第二行将“数据”表中的行复制到“查找”表中。该行已找到与用户输入相匹配的行。

此后，它返回搜索，直到到达“数据”表中的数据末尾。但是我确定是复制导致速度缓慢和崩溃。

非常感谢您。

Answer 1

加快复制/粘贴范围

如果您不知道，关闭Application.ScreenUpdating尤其是Application.Calculation的（False）也将提高代码的执行速度。

联盟范围版本

Sub CopyRangeToSheetUnion()

  ' Source
  Const cVntSrc As Variant = "Sheet1"      ' Source Worksheet Name/Index
  Const cStrSrcRange As String = "A1:J10"  ' Source Range
  Const cIntColumn As Integer = 1          ' Source Search Column

  ' Target
  Const cStrTgtCell As String = "A1"   ' Target First Cell Range
  Const cVntTgt As Variant = "Sheet2"  ' Target Worksheet Name/Index

  Dim rngU As Range      ' Union Range
  Dim i As Long          ' Source Range Row Counter

  With Worksheets(cVntSrc).Range(cStrSrcRange)

    ' Loop through each cell in column cIntColumn of Source Range and copy
    ' to Union Range if condition is met.
    For i = 1 To .Rows.Count
      If .Cells.Cells(i, cIntColumn).Value <> "" Then
        If Not rngU Is Nothing Then
          Set rngU = Union(rngU, .Cells(i, cIntColumn))
         Else
          Set rngU = .Cells(i, cIntColumn)
        End If
      End If
    Next

  End With

  ' Copy entire rows from Union range to Target Range.
  If Not rngU Is Nothing Then
    rngU.EntireRow.Copy Worksheets(cVntTgt).Range(cStrTgtCell)
    Set rngU = Nothing
  End If

End Sub

阵列版本

这是一个带有条件的示例，该条件会复制“ A”列中没有空单元格的每一行（我将很快使用Union方法发布一个带有条件的示例）。

Sub CopyRangeToSheetArray()

  ' Source
  Const cVntSrc As Variant = "Sheet1"      ' Source Worksheet Name/Index
  Const cStrSrcRange As String = "A1:J10"  ' Source Range
  Const cIntColumn As Integer = 1          ' Source Search Column

  ' Target
  Const cStrTgtCell As String = "A1"   ' Target First Cell Range
  Const cVntTgt As Variant = "Sheet2"  ' Target Worksheet Name/Index

  Dim vntSrc As Variant  ' Source Array
  Dim vntTgt As Variant  ' Target Array
  Dim i As Long          ' Source Array Row Counter
  Dim j As Integer       ' Source/Target Array Column Counter
  Dim k As Long          ' Target Array Column Count/Counter

  ' Paste the Source Range into Source Array.
  vntSrc = Worksheets(cVntSrc).Range(cStrSrcRange)

  ' Count the number of rows that meet the condition.
  For i = 1 To UBound(vntSrc)
    If vntSrc(i, cIntColumn) <> "" Then
      k = k + 1
    End If
  Next

  ' Resize Target Array.
  ReDim vntTgt(1 To k, 1 To UBound(vntSrc, 2))

  ' Reset Target Array Column Counter
  k = 0

  ' Write from Source to Target Array.
  For i = 1 To UBound(vntSrc)
    If vntSrc(i, cIntColumn) <> "" Then
      k = k + 1
      For j = 1 To UBound(vntSrc, 2)
        vntTgt(k, j) = vntSrc(i, j)
      Next
    End If
  Next

  ' Paste Target Array into Target Worksheet
  Worksheets(cVntTgt).Range(cStrTgtCell) _
      .Resize(UBound(vntTgt), UBound(vntTgt, 2)) = vntTgt

End Sub

开胃菜

这里是无条件复制特定范围的样本。您可以更改（增加）常量部分中的值，并对其进行操作以查看其速度如何并更好地理解其概念。我将很快发布带有条件的样本。

Sub CopyRangeToSheet()

  ' Source
  Const cVntSrc As Variant = "Sheet1"      ' Source Worksheet Name/Index
  Const cStrSrcRange As String = "A1:J10"  ' Source Range

  ' Target
  Const cStrTgtCell As String = "A1"   ' Target First Cell Range
  Const cVntTgt As Variant = "Sheet2"  ' Target Worksheet Name/Index

  Dim vntSrc As Variant  ' Source Array

  With Worksheets(cVntSrc)
    vntSrc = .Range(cStrSrcRange)
    Worksheets(cVntTgt).Range(cStrTgtCell) _
        .Resize(UBound(vntSrc), UBound(vntSrc, 2)) = vntSrc
  End With

End Sub

Answer 2

我发现，首先对整个表进行排序，然后在复制整个批量之前使用过滤器比复制每一行要快得多。

'Number of rows
lonYMax = Sheets("YourTable").Cells(Rows.Count, 1).End(xlUp).Row

ActiveSheet.Range("$A$1:$AE$" & lonYMax).AutoFilter Field:=24, Criteria1:= _
   "Your filter"
Range("A1:AE" & lonYMax).Select
'Copy whole section
Selection.Copy
Windows("OtherWorkbook.xlsx").Activate
Range("A1").Select
'Insert bulk
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close

Answer 3

尝试了一些方法，包括范围联合、数组等，将特定行从一张纸复制到另一张纸。
所有人都在花时间。

这种方法（一种非直接的方法）让我的处理速度更快：

在第 1 张纸上填充条件将值/字符串评估到新/最后一列，并将此新列单元格保留为我需要保留的行的空。
之后，将完整的工作表数据复制到新工作表中

    Range("A1:O" & nRows).Copy Destination:=Sheets(s2).Range("A1")

现在从 sheet1 中删除了所有条件填充的行

    For rw = nRows To 2 Step -1 ' from bottom to top looping
        If Cells(rw, "O") <> "" Then
            Rows(rw).EntireRow.Delete
        End If
    Next

从 sheet2 中删除了所有没有条件的行

    Sheets(s2).Select
    For rw = nRows To 2 Step -1 ' from bottom to top looping
        If IsEmpty(Cells(rw, "O")) Then
            Rows(rw).EntireRow.Delete
        End If
    Next

这绝对不是直接的方法，
但是，将行从一张纸直接复制到另一张纸的 vba 代码
并且使用范围并使用联合附加到它会消耗大量处理时间！当我们需要处理数千行时。

这里的技巧是一次性复制完整数据，无论有没有过滤器。之后，删除行操作不会花费太多时间。

我在这里只提到了理解逻辑所需的步骤代码。

我很高兴知道，如果有其他更快的直接方法，请发表评论。

Answer 4

不确定这是否适用，但是，在一种情况下，复制单元格而不是行会产生巨大的差异。

我有一个“待办事项列表”Excel 工作簿，其中包含大约 30 个工作表，所有工作表都采用相同的“待办事项”列格式。当我按下控件表单上的按钮时，VBA 会通读每个工作表（“详细信息”工作表）并找到具有非空白优先级列的“待办事项”行。然后将这些行中的每一行复制到工作簿前面的“操作”表中，因此所有详细信息表中的所有操作项都在一个列表中可见。还有一些其他功能，例如格式化、排序和将复制的操作表行链接回源表。

我使用此代码从详细信息表复制到操作表。总共有大约 200 个操作项，这需要花费几分钟的时间。

   ws.Rows(n).EntireRow.Copy  '''' Detail sheet row
   aws.Rows(awsAddRow).EntireRow.PasteSpecial ''''' Action sheet row

我把上面的代码改成这个代码，逐列复制单元格，需要几秒钟。

   For cl2 = 1 To 30
      aws.Cells(awsAddRow, cl2) = ws.Cells(n, cl2)
   Next cl2

格式和链接等似乎都很好。

加快excel vba将数据从一张纸复制到另一张纸的

4 个答案:

加快复制/粘贴范围

联盟范围版本

阵列版本

开胃菜