根据大量数据中的列A中的标识符复制单元格
嗨，我有一个大的数据在A：J列。 如果列A中有数字1，则需要一个macros来复制列B：J，并将其粘贴到B列最后一项下的Sheet2中。
我已经写了几个macros来做到这一点，但是他们都花了很长时间来运行，而且效率非常低，因为要循环遍历每一行数据来检查列A中的标识符。
有没有一种有效的方式，而不是整个代码遍历所有9000行数据？
1可能只会出现在前2,500（最大）行，但是这个数量将会每月变化。
1将永远是彼此相邻的 – 也就是说，一旦它search到列Afind1，所有其他事件将是1，直到它变成2。 也不会有差距。 TIA
这是相当的瞬间，我为我的榜样设置了16000行，速度非常快。 我假设row1有标题。
Sub GetIt() Dim sh As Worksheet, ws As Worksheet Dim LstRw As Long, rng As Range Set sh = ActiveSheet Set ws = Sheets("Sheet2") Application.ScreenUpdating = 0 With sh LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row Set rng = .Range("B2:J" & LstRw) .Columns("A:A").AutoFilter Field:=1, Criteria1:="1" rng.SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial xlValues .AutoFilterMode = 0 Application.CutCopyMode = 0 End With End Sub
作为替代，我已经将sheet1中的所有数据加载到二维数组中，然后检查数组的第一个元素(x, 1) ，如果此元素的值为1则元素(x, 2)到(x, 10)被复制到收集所有结果的第二个数组中。 一旦所有的行被选中，第二个数组将被一次性地添加到第二个表中的表中。 结果是：
已经在1,08秒中检查了100.000行，49.960行已被复制到Sheet2。
出于好奇，我检查了Excel允许的最大数据行数：
在8,05秒中检查了1.048.574行，524.340行已被复制到Sheet2。
假设
- 2工作表
- 目标被格式化为一个表（listobject）
我可能会补充说有更简单的解决scheme。
Option Explicit Sub copyData() Dim wsDat As Worksheet, wsDes As Worksheet Dim tblDes As ListObject Dim i As Long, j As Long, k As Long Dim arrDat() As Variant, arrDes() As Variant Dim lastRow As Long, lastColumn As Long, nextRow As Long Dim rngDes As Range Set wsDat = ThisWorkbook.Worksheets(1) 'Change the numbers 1 and 2 to the names of the actual sheets and tables Set wsDes = ThisWorkbook.Worksheets(2) Set tblDes = wsDes.ListObjects(1) With wsDat lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column lastRow = .Cells(.Rows.Count, lastColumn).End(xlUp).Row arrDat = .Range(.Cells(1, 1), .Cells(lastRow, lastColumn)) End With For i = 1 To UBound(arrDat, 1) If arrDat(i, 1) = 1 Then j = j + 1 End If Next i ReDim arrDes(1 To j, 1 To lastColumn - 1) k = 1 For i = 1 To UBound(arrDat, 1) If arrDat(i, 1) = 1 Then For j = 1 To UBound(arrDes, 2) arrDes(k, j) = arrDat(i, j + 1) Next j k = k + 1 End If Next i With wsDes tblDes.ListRows.Add nextRow = tblDes.ListRows.Count Set rngDes = tblDes.DataBodyRange(nextRow, 2) Set rngDes = rngDes.Resize(UBound(arrDes, 1), UBound(arrDes, 2)) rngDes.Value = arrDes End With End Sub