如何让 VBA 复制一系列单元格，等待单元格计算并粘贴到另一个范围内？

Question

此代码将进入工作表并将单元格切换到某个函数，该函数链接到我要复制的范围。然后它将在特定单元格的另一张纸上粘贴值。每次复制和粘贴时，我都会更改 ActiveCell（第 6 行）。此代码不等待将被复制的单元格进行计算。因此，我的整个工作表中有相同的单元格值。任何帮助都会很棒:) 我尝试了“Application.Calculate”，但没有奏效。这段代码继续复制和粘贴 100 个不同的股票代码，我包括了五个系列的代码，但它们继续记录每个股票的价格。

Sheets("Investing").Select
    ActiveWindow.SmallScroll Down:=21
    Sheets("Homepage").Select
    Range("J2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=Investing!R[268]C[-9]"
    Range("J3").Select
    Sheets("Investing").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("A249:B260").Select
    Selection.Copy
    Sheets("Daily Strategies").Select
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Homepage").Select
    Range("J2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=Investing!R[269]C[-9]"
    Range("J3").Select
    Sheets("Investing").Select
    Range("A249:B260").Select
    Selection.Copy
    Range("D283").Select
    Sheets("Daily Strategies").Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Homepage").Select
    Range("J2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=Investing!R[270]C[-9]"
    Range("J3").Select
    Sheets("Investing").Select
    Range("A249:B260").Select
    Selection.Copy
    Sheets("Daily Strategies").Select
    Range("I5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Homepage").Select
    Range("J2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=Investing!R[271]C[-9]"
    Range("J3").Select
    Sheets("Investing").Select
    Range("A249:B260").Select
    Selection.Copy
    Sheets("Daily Strategies").Select
    Range("K5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Homepage").Select
    Range("J2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=Investing!R[272]C[-9]"
    Range("J3").Select
    Sheets("Investing").Select
    Range("A249:B260").Select
    Selection.Copy
    Sheets("Daily Strategies").Select
    Range("M5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

我

Answer 1

工作簿计算

• 将代码复制到标准模块中（例如Module1）。
• 调整constant，包括workbook。
• 如果不起作用，请尝试注释掉的行 包含Calculate一一。

守则

Option Explicit

Sub insertVarious()

    'Application.CalculateFullRebuild

    Const hpgName As String = "Homepage"
    Const hpgCell As String = "J2"

    Const invName As String = "Investing"
    Const invAddr As String = "A249:B260"
    Const invAddr2 As String = "A270:A371"

    Const dstName As String = "Daily Strategies"
    Const dstFirst As String = "E5"

    Dim wb As Workbook: Set wb = ThisWorkbook

    Dim hpg As Range: Set hpg = wb.Worksheets(hpgName).Range(hpgCell)
    Dim inv As Range: Set inv = wb.Worksheets(invName).Range(invAddr)
    Dim inv2 As Range: Set inv2 = wb.Worksheets(invName).Range(invAddr2)
    Dim UB1 As Long: UB1 = inv.Rows.Count
    Dim UB2 As Long: UB2 = inv.Columns.Count
    Dim NoA As Long: NoA = inv2.Rows.Count

    Dim Daily As Variant: ReDim Daily(1 To UB1, 1 To NoA * UB2)
    Dim Curr As Variant, j As Long, k As Long, l As Long
    For j = 1 To NoA
        hpg.Value = inv2.Cells(j).Value
        'hpg.Parent.Calculate
        'inv.Parent.Calculate
        Curr = inv.Value
        GoSub writeDaily
    Next j

    wb.Worksheets(dstName).Range(dstFirst).Resize(UB1, NoA * UB2) = Daily

    MsgBox "Data transferred.", vbInformation, "Success"

    Exit Sub

writeDaily:
    For k = 1 To UB1
        For l = 1 To UB2
            Daily(k, (j - 1) * 2 + l) = Curr(k, l)
        Next l
    Next k
    Return

End Sub