通过单元格引用在另一张表中循环输入值，然后复制公式值并使用 vba 将其粘贴到另一张表中

Question

[

我正在处理两张表格 Sheets("UPDATER") = 放置输入数据的位置（超过 700 行）以及需要复制数据的位置 Sheets("Historical_vol) = 我保存公式 (C9:N9) 和输入的位置来自history_vol表单元格A9中的更新表的记录。目的是获取粘贴在sheets("updater").columns("AB")中的每个底层证券的值，但这些值是从sheets("Historical_vol")中计算出来的.column(C9:F9) 然后将这些值粘贴到每行从单元格 AD4 开始的 sheet("updater") 中。

Sub historical_vol()
Dim i As Long
Dim a As Worksheet
Dim b As Worksheet

lr = Worksheets("UPDATER").Cells(Rows.count, "AB").End(xlUp).Row
Set a = Worksheets("UPDATER")
Set b = Worksheets("Historical_vol")
 For i = 4 To lr

 b.Range("A9").value = a.Range("AB4" & i).value
 'b.Range("C9":F9").Calculate
 Application.Wait (Now + TimeValue("00:00:02"))
 b.Range("C9:F9").Copy
 NextRow = Cells(Rows.count, "AD").End(xlUp).Row + 1
 Cells(NextRow, "AD").Select
 ActiveSheet.Paste

 Next i

End Sub

Answer 1

起初我注意到b.Range("A9").value = a.Range("AB4" & i).value应该是b.Range("A9").value = a.Range("AB" & i).value

正如我看到您正在使用Application.Wait ，我认为它是用于计算的。 所以，我建议使用xlCalculationManual计算并在完成后将其重置为自动，如下所示。

Sub historical_vol()
Application.ScreenUpdating = True
'This will help to watch the status bar update

Application.Calculation = xlCalculationManual
Dim wb As Workbook, uPd As Worksheet, hV As Worksheet
Dim lr As Long, cl As Range

Set wb = ThisWorkbook
Set uPd = wb.Sheets("UPDATER")
Set hV = wb.Sheets("Historical_vol")

lr = uPd.Cells(Rows.Count, "AB").End(xlUp).Row
i = 0
For Each cl In uPd.Range("AB4:AB" & lr)
hV.Range("A9").Value = cl.Value
hV.Calculate
cl.Offset(0, 2).Resize(1, 4).Value = hV.Range("C9:F9").Value
i = i + 1

Application.StatusBar = i '& " / " & lr - 3
'View on status bar number of records completed out of total records (lr-3)
Next

Application.Calculation = xlCalculationAutomatic
End Sub