excel - 如何一个接一个地复制列并在每次复制之间执行计算？

Question

如果有人可以帮助我解决以下问题，我将不胜感激。

我有 1300 列数据(每列代表股票价格)，其中一些最多 375 个数据点，而另一些则少于 375 个数据单元(如果您愿意，也可以是几个月)。

我需要从 Data 复制 A 列至Sheet3 Range("B2") ，然后将在 Range("E6") 中启动已经预定义的公式计算一些值。然后我想要 Sheet3.Range("E6")要复制到 Sheet3.Range("I:I) 的底部.然后我需要重复相同的操作，但这次取 B 列并执行相同的操作(对于数据表中的 1300 列也是如此)。

我开始编写一些代码但没有成功。请指教。谢谢

Sub CopyCols()
    Const NUM_TIMES As Long = 10
    Dim Sheet3 As Worksheet, shtData As Worksheet
    Dim rngCopy As Range, i As Long

    Set Sheet3 = Sheets("Sheet3")
    Set shtData = Sheets("Data")
    Set rngCopy = shtData.Range("A1:A375")

    For i = 1 To NUM_TIMES
        With Sheet3
            .Range("B2").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value
            .Range("E5").Copy
            .Range("I1:I" & Cells(Rows.Count, "I").End(xlUp).Row).PasteSpecial xlPasteValues
            .Calculate
            'rngCopy(1).Offset(17, 0).Resize(8, 1).Value = .Range("P12:P19").Value
        End With
        'Set rngCopy = rngCopy.Offset(0, 1)
    Next i
End Sub

Answer 1

代码中的主要问题是 Set rngCopy = shtData.Range("A1:A375")被排除在循环之外。

据我所知，代码重组和测试

Sub CopyCols()
Const NUM_TIMES As Long = 1300
Dim Sht3 As Worksheet, shtData As Worksheet
Dim rngCopy As Range, i As Long
'Dim Arr As Variant
Dim tm As Double

tm = Timer
Set Sht3 = Sheets("Sheet3")
Set shtData = Sheets("Data")
Set rngCopy = shtData.Range("A1:A375")

    For i = 1 To NUM_TIMES
    Set rngCopy = shtData.Range(shtData.Cells(1, i), shtData.Cells(375, i))
    With Sht3
    .Range("B2").Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value
    .Calculate
    .Range("I" & Cells(Rows.Count, "I").End(xlUp).Row + 1).Value = .Range("E6").Value
    End With
    Next i
Debug.Print "Seconds taken" & Timer - tm
End Sub

Sheet3名称更改为 Sht3姓名 Sheet3可能与工作簿中现有工作表的代号相矛盾。最多复制 375 行(在实际情况下使其成为可能的最大值。它比计算最后一行并复制它更好的选择，它需要从 Sheet3 列 B 中清除先前列数据的额外要求。这将使性能较慢。