使用Offset粘贴到特定行的下方

Question

我正在尝试对不同的场景进行分析。

假设第1行有当前/基本结果。

我想将第1行的结果粘贴到下面对应于该场景的行中。

示例-第2行的场景1，第3行的场景2，依此类推。

宏一次只分析一个场景。

当我指定在第2-10行运行场景时，它将正确地粘贴到第2-10行。

但是，当我在第5-10行运行场景时，它将粘贴到第2-7行，而不是第5-10行。

此代码适用于其他工作簿。

Sub Add_sce()

Application.ScreenUpdating = False
Application.Calculation = xlManual

'Clearing cell contents
Sheets("Sensitivity Analysis").Range("SCE_clean").Select
Selection.ClearContents

'Creating an area to paste results of each simulation for each scenario
Worksheets("Appendix-PSA").Select
Range("PSA_iteration") = Range("addscen_iteration")

Range("PSA_sim_pasted_results").Select
Selection.ClearContents
Range("PSA_sim_current_results").Select
Selection.Copy
Range("PSA_sim_pasted_results").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False

Count = 0 / (Range("AD_stop").Value - Range("AD_start").Value)
Application.StatusBar = Count

'Replacing basecase values for variable with scenario values
Dim i As Integer

For i = Range("AD_start").Value To Range("AD_stop").Value

    Sheets("Model Parameters").Range(Sheets("Sensitivity Analysis").Range("V" & i & ":V" & i)) = _
      Sheets("Sensitivity Analysis").Range("Z" & i & ":Z" & i)

    If Sheets("Sensitivity Analysis").Range("W" & i & ":W" & i) <> "" Then
        Sheets("Model Parameters").Range(Sheets("Sensitivity Analysis").Range("W" & i & ":W" & i)) = _
          Sheets("Sensitivity Analysis").Range("AA" & i & ":AA" & i)
    Else
    End If

    If Sheets("Sensitivity Analysis").Range("X" & i & ":X" & i) <> "" Then
        Sheets("Model Parameters").Range(Sheets("Sensitivity Analysis").Range("X" & i & ":X" & i)) = _
          Sheets("Sensitivity Analysis").Range("AB" & i & ":AB" & i)
    Else
    End If

    If Sheets("Sensitivity Analysis").Range("Y" & i & ":Y" & i) <> "" Then
        Sheets("Model Parameters").Range(Sheets("Sensitivity Analysis").Range("Y" & i & ":Y" & i)) = _
          Sheets("Sensitivity Analysis").Range("AC" & i & ":AC" & i)
    Else
    End If

    'Starting simulation
   
    Worksheets("Appendix-PSA").Select
    Call PSA

    Calculate
    
    '**Problem is somewhere here - it is supposed to copy from range add_result and 
    ' Paste it in the row specified by 
    ' the scenario number i and starting row number AD_start

    Worksheets("Sensitivity Analysis").Select

    Range("add_result").Select
    Selection.Copy
    ActiveCell.Offset(i + 1 - Range("AD_start"), 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

    'Replacing scenario values with default values
    Worksheets("Model Parameters").Select
    Call Default

    Worksheets("Sensitivity Analysis").Select

    Count = Round((i - Range("AD_start").Value) / (Range("AD_stop").Value - Range("AD_start").Value), 2) * 100 & " %"
    Application.StatusBar = Count

Next i

Worksheets("Appendix-PSA").Select
Range("PSA_sim_pasted_results").Select
Selection.Copy
Range("PSA_sim_current_results").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False

Worksheets("Sensitivity Analysis").Select
Range("a1").Select
Application.Calculation = xlAutomatic
Calculate

Answer 1

如果你想找出代码中的错误，这就是你的代码应该是什么样子。

Option Explicit

Sub Add_sce()
    ' 172

    Dim WsSA        As Worksheet                ' "Sensitivity Analysis"
    Dim WsPSA       As Worksheet                ' "Appendix-PSA"
    Dim WsMod       As Worksheet                ' "Model Parameters"
    Dim RngName     As String
    Dim ADstart     As Long
    Dim ADstop      As Long
    Dim i           As Long

    ' declare referenced worksheets 
    Set WsSA = Worksheets("Sensitivity Analysis")
    Set WsPSA = Worksheets("Appendix-PSA")
    Set WsMod = Worksheets("Model Parameters")

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    
    ' Clearing cell contents
    WsSA.Range("SCE_clean").ClearContents

    With WsPSA
        ' Creating an area to paste results of each simulation for each scenario
        '   This code doesn't create anything.
        '   It assigns the value from one range to the other.
        '   The two ranges must be of the same size and on the same sheet.
        .Range("PSA_iteration").Value = .Range("addscen_iteration").Value
        
        ' clearing "PSA_sim_pasted_results" should be superfluous
        ' because any existing contents would be over-written
        .Range("PSA_sim_pasted_results").ClearContents
        .Range("PSA_sim_current_results").Copy
        .Range("PSA_sim_pasted_results").PasteSpecial Paste:=xlPasteValues, _
                                                      Operation:=xlNone, _
                                                      SkipBlanks:=False, _
                                                      Transpose:=False
        
        ' reading from the sheet takes a lot of time
        ' therefore don't read the same value more than once
        ADstart = .Range("AD_start").Value
        ADstop = .Range("AD_stop").Value
        
        ' This formula will always either be 0 or #DIV/0 Error
        Application.StatusBar = 0 / (ADstop - ADstart)
    End With

    ' Replacing basecase values for variable with scenario values
    For i = ADstart To ADstop
        RngName = WsSA.Cells(i, "V").Value
        WsMod.Range(RngName).Value = WsSA.Cells(i, "Z").Value
        
        If WsSA.Cells(i, "W").Value = "" Then
            RngName = WsSA.Cells(i, "W").Value
            WsMod.Range(RngName).Value = WsSA.Cells(i, "AA").Value
        End If
        
        If WsSA.Cells(i, "X").Value = "" Then
            RngName = WsSA.Cells(i, "X").Value
            WsMod.Range(RngName).Value = WsSA.Cells(i, "AB").Value
        End If
        
        If WsSA.Cells(i, "Y").Value = "" Then
            RngName = WsSA.Cells(i, "Y").Value
            WsMod.Range(RngName).Value = WsSA.Cells(i, "AC").Value
        End If

        ' Starting simulation
        Call PSA(WsPSA)
        Calculate
        
        ' Problem is somewhere here:-
        ' it is supposed to copy from range "add_result" and Paste it in the row
        ' specified by the scenario number i and starting row number AD_start
        ' The problem hails from the ActiveCell:-
        '   ActiveCell.Offset(i + 1 - Range("AD_start"), 0)
        ' That's a cell clicked by the user. It needs to be replaced with
        ' a cell determined by the macro.

        WsSA.Range("add_result").Copy
        ' can't figure out even the sheet you want to paste to, let alone the column.
        ' Specify the TopLeft cell as Cells([Row], [Column])
        WsSA.Cells(i + 1 - ADstart, "AA").PasteSpecial Paste:=xlPasteValues, _
                                                       Operation:=xlNone, _
                                                       SkipBlanks:=False, _
                                                       Transpose:=False

        ' Replacing scenario values with default values
        Call Default(WsMod)
        Application.StatusBar = Format((i - ADstart) / (ADstop - ADstart), "0.00%")
    Next i

    With WsPSA
        .Range("PSA_sim_pasted_results").Copy
        .Range("PSA_sim_current_results").PasteSpecial Paste:=xlPasteValues, _
                                                       Operation:=xlNone, _
                                                       SkipBlanks:=False, _
                                                       Transpose:=False
    End With

    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic              ' this triggers calculation
        .CutCopyMode = False
        .StatusBar = "Done"
    End With
    
    With WsSA
        .Activate
        .Cells(1, 1).Select
    End With
End Sub

Private Sub PSA(WsPSA As Worksheet)

    With WsPSA
        ' precede your range and cell addresses with a period
        ' to make them refer to WsPSA
    End With
End Sub

Private Sub Default(WsMod As Worksheet)

    With WsMod
        ' precede your range and cell addresses with a period
        ' to make them refer to WsMod
    End With
End Sub

但是，在我们可以查找错误之前，必须完成转换作业。您的两个子例程Default和PSA可能作用于您的代码一直在更改的ActiveSheet。我的代码不能做到这一点。因此，必须告诉subs要在哪张纸上工作。上面的代码演示了如何将工作表对象传递给子对象，以及子对象如何接收参数。现在，您应该更改这两个过程的代码，以使用给定的工作表。确保按照我在上面的代码中演示的方式删除所有Select或Activate语句。

现在，错误：-它是由对ActiveCell的引用引起的。这是用户在启动宏之前最后单击的单元格。您的代码尝试确定与其相关的目标单元格。在尝试运行之前，请在上述代码的这一部分中指定正确的目标单元格。

WsSA.Range("add_result").Copy
' can't figure out even the sheet you want to paste to, let alone the column.
' Specify the TopLeft cell as Cells([Row], [Column])
WsSA.Cells(i + 1 - ADstart, "AA").PasteSpecial Paste:=xlPasteValues, _

不用说，我不能运行代码。对于您可能会发现的各种错误，我深表歉意。重点是你可以找到他们，可以纠正他们，但如果你需要帮助，请要求。