Макрос для перебора вычислений по листам и вставки значений дает неправильные результаты

#excel #vba

#excel #vba

Вопрос:

У меня есть простой макрос для последовательного копирования столбца входных значений, вставки в ячейку, которая является частью большого вычисления (по рабочим книгам), а затем вставки выходных данных в таблицу (рядом со столбцом входных значений). Каким-то образом результаты, которые выдает макрос, не совпадают со значениями, которые выдает формула, если я вручную вставляю входное значение. Если я запускаю макрос дважды, это происходит. Любая помощь в решении этой проблемы будет высоко оценена. Мой код приведен ниже:

 Sub Macro6()
'
' Macro6 Macro
'
Dim a, b, c, d As Integer

Sheets("PPT_US Sensitivity").Range("E6").Value = "YES"

Application.ScreenUpdating = False
Application.CalculateFull
Sheets("PPT_US Sensitivity").Range("H9").Copy
Sheets("Dropdowns").Range("E14").PasteSpecial Paste:=xlPasteValues
Application.CalculateFull
Sheets("Cockpit").Range("AA40:Ad47").Copy
Sheets("Cockpit").Range("Ak40:An47").PasteSpecial Paste:=xlPasteValues

For a = 0 To 22
Sheets("PPT_US Sensitivity").Range("e13").Offset(a, 0).Copy
Sheets("US-specific assumptions").Range("e126").PasteSpecial Paste:=xlPasteValues
Application.CalculateFull
Sheets("Cockpit").Range("AA44").Copy
Sheets("PPT_US Sensitivity").Range("f13").Offset(a, 0).PasteSpecial Paste:=xlPasteValues
Next a

For b = 0 To 22
Sheets("PPT_US Sensitivity").Range("e13").Offset(b, 0).Copy
Sheets("US-specific assumptions").Range("i126").PasteSpecial Paste:=xlPasteValues
Application.CalculateFull
Sheets("Cockpit").Range("AB44").Copy
Sheets("PPT_US Sensitivity").Range("g13").Offset(b, 0).PasteSpecial Paste:=xlPasteValues
Next b

For c = 0 To 22
Sheets("PPT_US Sensitivity").Range("e13").Offset(c, 0).Copy
Sheets("US-specific assumptions").Range("L126").PasteSpecial Paste:=xlPasteValues
Application.CalculateFull
Sheets("Cockpit").Range("AC44").Copy
Sheets("PPT_US Sensitivity").Range("h13").Offset(c, 0).PasteSpecial Paste:=xlPasteValues
Next c

For d = 0 To 22
Sheets("PPT_US Sensitivity").Range("e13").Offset(d, 0).Copy
Sheets("US-specific assumptions").Range("Q126").PasteSpecial Paste:=xlPasteValues
Application.CalculateFull
Sheets("Cockpit").Range("AD44").Copy
Sheets("PPT_US Sensitivity").Range("i13").Offset(d, 0).PasteSpecial Paste:=xlPasteValues
Next d

Application.ScreenUpdating = True
Sheets("PPT_US Sensitivity").Range("E6").Value = "NO"

'
End Sub 
  

Ответ №1:

Извините, но мне пришлось переписать ваш код, чтобы я мог видеть, что происходит. Вот на что я, наконец, посмотрел.

 Sub YourMacro()
    ' 092
    
    Dim WsPit   As Worksheet            ' "Cockpit"
    Dim WsPPT   As Worksheet            ' "PPT_US Sensitivity"
    Dim WsAss   As Worksheet            ' "US-specific assumptions"
    Dim C       As Long                 ' loop counter: column
    Dim R       As Long                 ' loop counter: row
    Dim i       As Long                 ' loop counter: iteration
    
    Set WsPit = Sheets("Cockpit")
    Set WsPPT = Sheets("PPT_US Sensitivity")
    Set WsAss = Sheets("US-specific assumptions")
    
    WsPPT.Range("E6").Value = "YES"
    Application.ScreenUpdating = False

    Sheets("Dropdowns").Range("E14").Value = WsPPT.Range("H9").Value
    With WsPit
        .Range("AA40:Ad47").Copy
        .Range("AK40:AN47").PasteSpecial Paste:=xlPasteValues
    End With

    WsPit.Range("AK40:AN47").Value = WsPit.Range("AA40:AD47").Value
    
    For i = 0 To 3
        C = Array(5, 9, 12, 17)(i)         ' specifying columns E, I, L and Q
        For R = 13 To 35
            WsAss.Cells(126, C).Value = WsPPT.Cells(R, "E").Value
            WsPPT.Cells(R, 6   i).Value = WsPit.Cells(44, 27   i).Value
        Next R
    Next i
    
    Application.ScreenUpdating = True
    WsPPT.Range("E6").Value = "NO"
End Sub
  

К сожалению, я не был вознагражден за свои усилия. Я могу читать, но не могу протестировать, и я сомневаюсь, что только переписывание вылечило какие-либо проблемы. Я предполагаю, что Sheets("Dropdowns").Range("E14").Value = WsPPT.Range("H9").Value присваивает новое значение раскрывающемуся списку проверки — возможно, прямо или косвенно (если выпадающий список берет свой список из диапазона, изменяемого кодом) — это не вступает в силу до второго запуска.

‘WsAss.Ячейки (126, C). Значение = WsPPT.Ячейки (R, «E»).Значение` быстро присваивает разные значения одной и той же ячейке. Изменение приведет к пересчету листа без дополнительных подсказок. Однако Excel может счесть вычисления ненужными, если обновление экрана отключено. Итак, если вам нужен результат повторного вычисления в следующей строке кода, а Excel делает это недостаточно быстро, замедлите выполнение макроса, включив обновление экрана. Однако, поскольку вы говорите, что при втором запуске все работает нормально, мне больше нравится мое первое предположение.

Комментарии:

1. спасибо — это сработало отлично. Использование вашего кода без обновления экрана, похоже, решило проблему. Спасибо за помощь!