Question

lrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
For p = 1 To lrow
    period(p) = p
Next p
With ws2
    lrow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1").Offset(lrow2, 1).Resize(lrow).Value = Application.Transpose(period)
    ws1.Range(ws1.Cells(5, 1), ws1.Cells(lrow, 1)).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 2)
End With

如您所见，我正在尝试将数据列从一个工作表复制到另一个工作表，并且效果很好。但是如果注意到我在p中生成序列从1到lastrow ，这看起来非常愚蠢，因为我正在使用循环，我确信还有另一种方法来生成它并将其复制到另一张纸。如何从代码中删除 application.transpose（句点）行使其在一半的时间内运行。如果有人可以提供建议，我要求更快的方法。谢谢。

E.g。

  Sheet1                           Sheet2
  John                          1  John
  Jim                           2  Jim
  Jack                          3  Jack

我从Sheet1生成Sheet2，数字和名称在不同的列中。我可以使用我的代码中的副本来获取名称，但我需要自己生成数字。

Answer 1

我对此感到好奇所以我测量了4个选项：

Max itms:    65,000
  Transpose: 0.0586 sec
  Formula:   0.0938 sec
  Fill down: 0.0273 sec <<<
  2D Array:  0.0547 sec

Max itms:    1,000,000
  Formula:   0.4688 sec
  Fill down: 0.2305 sec <<<
  2D Array:  0.6992 sec

测试代码：

Public Sub idSequence()
    Const MAXR As Long = 1000000
    Const CRx2 As String = " sec" & vbCrLf  ' & vbCrLf
    Const NFRM As String = "#,##0.0000"
    Dim arr As Variant, i As Long, msg As String, t As Double

    If MAXR <= 65000 Then    'Upper Limit: 65,000
        t = Timer
        ReDim arr(1 To MAXR)
        For i = 1 To MAXR
            arr(i) = i
        Next
        Range("A1:A" & MAXR).Formula = Application.Transpose(arr)
        msg = msg & "Transp: " & vbTab & Format(Timer - t, NFRM) & CRx2
    End If

    t = Timer
    Range("B1:B" & MAXR).Formula = "=Row()"
    msg = msg & "Formula:" & vbTab & Format(Timer - t, NFRM) & CRx2

    t = Timer
    Range("C1") = 1
    Range("C1:C" & MAXR).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
    msg = msg & "Fill down:" & vbTab & Format(Timer - t, NFRM) & CRx2

    t = Timer
    ReDim arr(1 To MAXR, 1 To 1)
    For i = 1 To MAXR
        arr(i, 1) = i
    Next
    Range("D1:D" & MAXR) = arr
    msg = msg & "2D Array:" & vbTab & Format(Timer - t, NFRM) & CRx2

    Debug.Print "Max itms: " & vbTab & Format(MAXR, "#,##0")
    Debug.Print msg
End Sub

Answer 2

所以你的问题是如何加快速度？第一个建议是将以下内容添加到开头并结束宏：

一开始：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

然后在最后：

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Answer 3

这将输出您要查找的列;一列中的数字和下一个中的名称：

Public Sub YourSolution()
    Dim v
    v = Sheet1.[CHOOSE({1,2},ROW(OFFSET(A1,,,COUNTA(A:A))),A1:INDEX(A:A,COUNTA(A:A)))]
    Sheet2.[b3:c3].Resize(UBound(v)) = v
End Sub

它应该足够快，您无需费心关闭屏幕更新或将计算设置为手动。

根据lastrow生成一系列直的数字

3 个答案: