Question

提前感谢您的帮助。我设法创建一个宏，在单元格值“True”中搜索名为“ClientTradeDetails”的工作表的列O，如果单元格值为“True”，则将整行划分并粘贴到名为“TrueValues”的工作表中。

它有效，但它非常慢。如您所见，我的主表中有65536行数据需要通过。我在想复制/粘贴是问题，但我不知道如何更改这个以避免复制方法。有什么帮助吗？

Sub MoveTrue()

Sheets("ClientTradeDetails").Select

 Dim tfCol As Range, Cell As Object

    Set tfCol = Range("O2:O439050") 'Substitute with the range '

    For Each Cell In tfCol

        If Cell.Value = "True" Then
            Cell.EntireRow.Cut
            Sheets("TrueValues").Select
            ActiveSheet.Range("A65536").End(xlUp).Select
            Selection.Offset(1, 0).Select
            ActiveSheet.Paste
        End If

    Next

End Sub

Answer 1

这可能比你想要的要复杂一点，但它比复制和粘贴数据更有效：

Sub GetTrueValues()

Dim ws As Worksheet
Dim arr() As Variant
Dim arrFound() As Variant
Dim arrOut() As Variant

Dim i As Long
Dim j As Long
Dim k As Long

Dim lConst As Long: lConst = 15 ' For the O column

Set ws = ActiveWorkbook.Sheets("SheetName")
arr() = ws.UsedRange.Value

For i = LBound(arr()) To UBound(arr())
    If arr(i, lConst) = "True" Then
        k = k + 1
        ReDim arrFound(1 To k)
        arrFound(k) = i
    End If
Next

ReDim arrOut(1 To k, 1 To UBound(arr(), 2))
For i = 1 To UBound(arrFound())
    For j = LBound(arr()) To UBound(arr(), 2)
        arrOut(i, j) = arr(arrFound(k), j) ' Using the previously stored integer,
                                           ' retrieve the records of interest.
    Next
Next

ActiveWorkbook.Sheets.Add
ActiveSheet.Range("A1").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)).Value = arrOut()

End Sub

这个宏本质上做的是查找值为true的记录数，然后将所有这些记录放入一个数组中并将数组反射回工作表。您可以根据需要更改打印出来的部分。

需要加速代码（从一张纸复制/粘贴到另一张）

1 个答案: