Эффективное умножение в VBA с макросами - PullRequest
0 голосов
/ 25 апреля 2020

Я пытаюсь создать код с эффективностью , насколько это возможно.

Что мне нужно сделать, это Умножить диапазон ячеек на фиксированное значение и затем замените значение, которое имела каждая ячейка, на это новое значение.

Например:

В диапазоне "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

Оба кода требуют слишком много времени для умножения в этот диапазон.

Что я могу сделать, чтобы ускорить умножение?

Любой вклад будет приветствоваться. От уже большое спасибо.

Ответы [ 3 ]

1 голос
/ 25 апреля 2020

Evaluate работает со ссылками на массивы и возвращает массив, который может быть назначен непосредственно диапазону, с которым вы работаете:

With Worksheets(3).Range("D5:D25")
    .Value = .Parent.Evaluate("=" & .address() & "*" & dollars)
End With
0 голосов
/ 25 апреля 2020

Я пытался с этим кодом и работает правильно и быстро. '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
0 голосов
/ 25 апреля 2020

Вместо копирования в массив вы можете использовать этот код

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

Если это быстрее, чем использовать массивы, я не проверял, но это должно быть быстрее, чем ваш первоначальный подход.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...