Question

正如我在标题中所说，我想知道是否有人可以帮我弄清楚为什么我的代码运行得这么慢（跑了一个小时没有结果）。在VBA写作方面，我是一个非常新的人，但我不明白为什么需要这么长时间。以下是有问题的代码：

Sub fast()
Application.ScreenUpdating = False

Dim prices As Worksheet
Dim stockreturns As Worksheet
Dim index As Worksheet
Dim stockprices As Range

Set index = Worksheets("IndexPrices")
Set prices = Worksheets("HistPrices")
Set stockreturns = Worksheets("Sheet1")

index.Range("A:B").Copy stockreturns.Range("A:B")

For col = 1 To 975
    For n = 2 To 260
        prices.Range("A:A").Offset(0, col).Copy stockreturns.Range("A:A").Offset(0, 2 * col + 1)
        If stockreturns.Cells(n + 1, 2 * col).Value = Null Or IsEmpty(stockreturns.Cells(n + 1, 2 * col).Value) Then
            stockreturns.Cells(n, 2 * col + 1) = Null
        Else
            stockreturns.Cells(n, 2 * col + 1).Formula = Cells(n, 2 * col) / Cells(n + 1, 2 * col) - 1
            stockreturns.Cells(n, 2 * col + 1).NumberFormat = "0.00%"
        End If
     Next n
Next col

Application.ScreenUpdating = True
End Sub

如果有人想要查看我在工作表中尝试完成的内容并且可能建议采用不同或更有效的方法，我会很乐意发布工作簿。感谢。

Answer 1

在我们继续优化之前，让我们确保它至少有效。请检查我评论的位置。假设上面的代码是正确的。在您的代码中，您只需修改为260行，以便将最后一行设置为260.我认为这需要更深入的调试才能工作。但如果按照这种方式进行，它将最终使你的程序完成得更快（比上面所有常规方法快几百倍）这个概念很相似。 1.将所有数据转储到内存（数组“stockdata和”pricingata“） 2.在内存中播放数据 3.写回文件 4.如果需要，添加格式。

Sub fast()
Dim stockdata,pricedata As Variant

    Application.ScreenUpdating = False
    ' Stop Excel from recalculating the workbook every time a cell value changes
    Application.Calculation = xlCalculationManual
    Dim prices As Worksheet, stockreturns As Worksheet, index As Worksheet
    ' Fully qualify your sheets by specifying the workbook
    With ThisWorkbook
        Set index = .Sheets("IndexPrices")
        Set prices = .Sheets("HistPrices")
        Set stockreturns = .Sheets("Sheet1")
    End With
    ' Assign some last row number so you don't have to be copying the value of tens of thousands of rows
    ' Previously every values copy was on the entire column, wasting a lot of time!
    ' Could get this value by a cleverer, more dynamic method, but that depends on needs.
    Dim lastrow As Long: lastrow = 260

    ' Assign values, don't use copy/paste. Avoiding the clipboard speeds things up
    stockreturns.Range("A1:B" & lastrow).Value = index.Range("A1:B" & lastrow).Value
    pricedata = prices.Range("A1",prices.Cells(lastrow,975))
    redim stockdata(1 to lastrow, 1 to 1952)    
    For col = 1 To 975
        'stockreturns.Range("A1:A" & lastrow).Offset(0, 2 * col + 1).Value = prices.Range("A1:A" & lastrow).Offset(0, col).Value
        for n = 1 to lastrow
        'offset so that +1
            stockdata(n,col*2+1+1)  = pricedata(n,col+1)
        next n
    next col
    'done with that

    'check value and change if need
    For col = 1 To 975

        For n = 2 To 260
            If stockdata(n + 1, 2 * col) = Null Or IsEmpty(stockdata(n + 1, 2 * col)) Then
                stockdata(n, 2 * col + 1) = Null
            Else
                stockdata(n, 2 * col + 1).Formula = stockdata(n, 2 * col) / stockdata(n + 1, 2 * col) - 1
                'stockdata(n, 2 * col + 1).NumberFormat = "0.00%"
            End If
         Next n
    Next col
    stockreturns.Range("A1",stockreturns.Cells(lastrow,1952)) = stockdata
    Dim rng As Range
    Set rng = stockreturns.Range("B1:B" & lr)
    For col = 2 To 975
        Set rng = Union(rng, Range(stockreturns.Cells(1,2*col + 1),stockreturns.Cells(lr,2*col + 1),)
    next n
    rng.NumberFormat = "0.00%"
    ' Reset Application settings
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 2

假设您的代码符合您的要求，下面的重新绘制应该更快。

尽可能避免使用.Copy。而是直接分配.Value个单元格。
确保您的代码行在正确的循环中，以避免比运行代码更频繁地运行代码。
停止对整个列执行每个操作，即很多您正在复制的单元格，其中99％将为空白！我采用了最基本的方法，并选择使用前1000行，将其改进为适合 - 可能是finding the actual last row。
禁用自动Calculation以及ScreenUpdating。

有关详细信息，请参阅代码注释。

Sub fast()
    Application.ScreenUpdating = False
    ' Stop Excel from recalculating the workbook every time a cell value changes
    Application.Calculation = xlCalculationManual
    Dim prices As Worksheet, stockreturns As Worksheet, index As Worksheet
    ' Fully qualify your sheets by specifying the workbook
    With ThisWorkbook
        Set index = .Sheets("IndexPrices")
        Set prices = .Sheets("HistPrices")
        Set stockreturns = .Sheets("Sheet1")
    End With
    ' Assign some last row number so you don't have to be copying the value of tens of thousands of rows 
    ' Previously every values copy was on the entire column, wasting a lot of time!
    ' Could get this value by a cleverer, more dynamic method, but that depends on needs.   
    Dim lastrow As Long: lastrow = 1000
    ' Assign values, don't use copy/paste. Avoiding the clipboard speeds things up
    stockreturns.Range("A1:B" & lastrow).Value = index.Range("A1:B" & lastrow).Value
    For col = 1 To 975
        ' This line isn't affected by the value of n, so move it outside the n loop! Again, use .Value not copy
        stockreturns.Range("A1:A" & lastrow).Offset(0, 2 * col + 1).Value = prices.Range("A1:A" & lastrow).Offset(0, col).Value
        For n = 2 To 260            
            If stockreturns.Cells(n + 1, 2 * col).Value = Null Or IsEmpty(stockreturns.Cells(n + 1, 2 * col).Value) Then
                stockreturns.Cells(n, 2 * col + 1) = Null
            Else
                stockreturns.Cells(n, 2 * col + 1).Formula = Cells(n, 2 * col) / Cells(n + 1, 2 * col) - 1
                stockreturns.Cells(n, 2 * col + 1).NumberFormat = "0.00%"
            End If
         Next n
    Next col
    ' Reset Application settings
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 3

主要问题：

你的这个嵌套循环执行975 * 260 = 253.500次：

For col = 1 To 975
    For n = 2 To 260
        prices.Range("A:A").Offset(0, col).Copy stockreturns.Range("A:A").Offset(0, 2 * col + 1)
        If stockreturns.Cells(n + 1, 2 * col).Value = Null Or IsEmpty(stockreturns.Cells(n + 1, 2 * col).Value) Then
            stockreturns.Cells(n, 2 * col + 1) = Null
        Else
            stockreturns.Cells(n, 2 * col + 1).Formula = Cells(n, 2 * col) / Cells(n + 1, 2 * col) - 1
            stockreturns.Cells(n, 2 * col + 1).NumberFormat = "0.00%"
        End If
     Next n
Next col

根据问题中的代码总结您正在做的事情：

基本上，您正在做的是获取B，C，D等列，并使用偏移将它们复制到D，E，G等。接下来，您将检查stockreturns工作表中下一行中复制的单元格的值是什么（例如，您检查D3，然后是D4等），并根据填充的E2，E3等具有空值，或者，您采取（（D2 / D3） - 1）作为一个值。初步检查是为了避免除以零错误，我认为。

注意：在代码中的这些行中，您引用了Cells(n, 2 * col)，因此始终是ActiveSheet，而我假设您希望使用这些值填充工作表stockreturns。即如果您在激活工作表prices的情况下运行公式，则公式将无法提供所需的输出。

致力于解决方案：

可以肯定的是，不进行253.500循环会更快，但要尽可能地一次填充所有内容。由于列号每次都会变化，我们会留下该循环，但嵌套的260循环我们可以很容易地摆脱：

优化975循环而不是253.500：

With stockreturns For col = 1 To 975 prices.Range("A:A").Offset(0, col).Copy .Range("A:A").Offset(0, 2 * col + 1) 'Now we fill up the entire 260 rows at once using a relative formula: .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).FormulaR1C1 = "=IF(R[+1]C[-1]="""","""",(RC[-1]/R[+1]C[-1])-1)" 'If you want a value instead of a formula, we replace the formula's with the value. If calculation is set to manual, you'll have to add an Application.Calculate here. .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).Value = .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).Value .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).NumberFormat = "0.00%" Next col End With

这将节省主要的执行时间。但是，我们也可以通过关闭计算并仅使用最末端的值替换公式来保存自己975计算操作：

第二次优化以避免执行期间的计算：

Application.Calculation = xlCalculationManual With stockreturns For col = 1 To 975 prices.Range("A:A").Offset(0, col).Copy .Range("A:A").Offset(0, 2 * col + 1) 'Now we fill up the entire 260 rows at once using a relative formula: .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).FormulaR1C1 = "=IF(R[+1]C[-1]="""","""",(RC[-1]/R[+1]C[-1])-1)" .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).NumberFormat = "0.00%" Next col End With Application.Calculate stockreturns.UsedRange.value = stockreturns.UsedRange.value

最后一个版本在几秒钟内运行。如果您可以更改stockreturns工作表布局并使用连续范围立即复制，则您不会需要这些975循环，但您可以通过以下操作获得所需的结果：

复制价格范围

在另一个范围内添加公式

计算

用值
替换公式
设置数字格式

希望这有帮助。

是什么让我的代码运行得如此之慢？

3 个答案: