VBA与宏的高效乘法

Question

我正在尝试创建一个尽可能高效的代码。

我需要做的是用一个固定值乘以一个范围的单元格，然后用这个新值替换每个单元格的值。

例如：

在"D5:25"范围内，我在每个单元格中都有不同的数值。然后，我将每个单元格乘以一个固定值，然后在每个单元格中替换新值(我的意思是在"D5:25"范围内(。

我可以通过两种方法解决它，但两者都是"低效">，因为当我运行代码时，它表明在该范围内执行所有乘法需要很长时间。

此外，由于我需要在其他范围内也这样做，我知道这段代码不会很有效，因为它需要很长时间。

我通过了两个代码，确实有效，但效率低下。

代码1:

Sub dolartopesos()
'Routine to pass to pesos all the prices of the products of each supplier that are in dollars.
dollars = Worksheets(3).Range("R1")
'---------------------------------------------------
With Worksheets(3)
'Currency exchange
For i = 5 To 25
.Cells(i, 4) = .Cells(i, 4) * dollars
Next i

End With

'---------------------------------------------------
End Sub

代码2:

Sub dolartopesos()
'Routine to pass to pesos all the prices of the products of each supplier that are in dollars.
dollars = Worksheets(3).Range("R1")
'---------------------------------------------------
''Currency exchange
Dim rng As Range: Set rng = Worksheets(3).Range("D5:25")
Dim cel As Range
For Each cel In rng.Cells
With cel
cel = Application.WorksheetFunction.Product(cel, dollars)
End With
Next cel
'---------------------------------------------------
End Sub

两个代码在该范围内相乘的时间都太长。

我能做些什么来加速乘法运算？

任何贡献都将受到欢迎。从已经非常感谢你。

Answer 1

Evaluate处理数组引用并返回一个数组，该数组可以直接分配给您正在处理的范围：

With Worksheets(3).Range("D5:D25")
.Value = .Parent.Evaluate("=" & .address() & "*" & dollars)
End With

Answer 2

您可以使用以下代码而不是复制到数组

Option Explicit
Sub TestIt()
Dim rg1 As Range, rg2 As Range
Dim val As Double
val = 2
Set rg1 = Range("D5:D25")
Set rg2 = rg1.Offset(0, 1) ' or any other free range of the same size
TurnOffFunctionality
rg2.Formula = "=RC[-1]*" & val  ' Adjust formula accordingly
rg1.Value = rg2.Value
rg2.Clear
TurnOnFunctionality
End Sub

' Procedure : TurnOffFunctionality
' Source    : www.TheExcelVBAHandbook.com
' Author    : Paul Kelly
' Purpose   : Turn off automatic calculations, events and screen updating
Private Sub TurnOffFunctionality()
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub
' Procedure : TurnOnFunctionality
' Source    : www.TheExcelVBAHandbook.com
' Author    : Paul Kelly
' Purpose   : turn on automatic calculations, events and screen updating
Private Sub TurnOnFunctionality()
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

如果这比使用我没有测试的数组更快，但它应该比您原来的方法更快。

Answer 3

我尝试过使用此代码，并且工作正常且快速。‘S1是包含美元价值的单元格。

With Sheets(3)
.[D5:D25] = .[D5:D25*S1]
.[F5:F25] = .[F5:F25*S1]
.[H5:H25] = .[H5:H25*S1]
.[J5:J25] = .[J5:J25*S1]
.[L5:L25] = .[L5:L25*S1]
End With