循环多个数组

Question

我无法创建一个高效的代码，该代码循环并返回从特定单元格开始的 7 个场景的结果，并使每个场景在紧邻特定单元格下方的单元格中返回。

感谢您的帮助，并对我的菜鸟技能水平表示歉意。

我正在运行的长格式脚本是这样的：

Sub Macro1()

Dim X As Worksheet
Dim Y As Worksheet
Set X = Sheets("Scenarios")
Set Y = Sheets("Portfolio Model")

'Run Flat Scenarios
X.Select
Range("M2").Select
If Range("M2") = "N" Then Range("M2").Value = "Y" Else Range("M2").Value = "Y"
            
'#1 Flat Scenario
Y.Select
Range("GO8").Select
    Selection.Copy
Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Calculate
Range("GK5").Select
    Selection.Copy
Range("GP8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
            
'#2 Flat Scenario
Y.Select
Range("GO9").Select
    Selection.Copy
Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Calculate
Range("GK5").Select
    Selection.Copy
Range("GP9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
            
'#3 Flat Scenario
Y.Select
Range("GO10").Select
    Selection.Copy
Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Calculate
Range("GK5").Select
    Selection.Copy
Range("GP10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
            
'#4 Flat Scenario
Y.Select
Range("GO11").Select
    Selection.Copy
Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Calculate
Range("GK5").Select
    Selection.Copy
Range("GP11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

'#5 Flat Scenario
Y.Select
Range("GO12").Select
    Selection.Copy
Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Calculate
Range("GK5").Select
    Selection.Copy
Range("GP12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

'#6 Flat Scenario
Y.Select
Range("GO13").Select
    Selection.Copy
Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Calculate
Range("GK5").Select
    Selection.Copy
Range("GP13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

'#7 Flat Scenario
Y.Select
Range("GO14").Select
    Selection.Copy
Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Calculate
Range("GK5").Select
    Selection.Copy
Range("GP14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
End Sub

这就是我在使脚本更高效并尝试循环运行方面所处的位置：

Sub Macro2()

Dim X As Worksheet
Dim Y As Worksheet
Set X = Sheets("Scenarios")
Set Y = Sheets("Portfolio Model")

'Run Flat Scenarios
X.Select
Range("M2").Select
If Range("M2") = "N" Then Range("M2").Value = "Y" Else Range("M2").Value = "Y"
        
    Dim j As Variant
    Dim jArray As Variant
    jArray = Array(0.085, 0.0875, 0.09, 0.0925, 0.095, 0.0975, 0.01)

    Dim i As Variant
    Dim iArray As Variant
    iArray = Array(1, 2, 3, 4, 5, 6, 7)
    
       For Each i In iArray
            Range("GK5").Copy
            Range("GP" & 7 + i).PasteSpecial xlValues
        
        For Each j In jArray
        Range("G3").Value = j
        Calculate
        
        Next
        
    Next

End Sub

Answer 1

通过将重复代码隔离在单个函数中（

Sub

），这可能是一个非常简单的无循环解决方案。

这里的优点是清晰。另外，请了解如何在代码中避免使用

Select

。

Option Explicit

Sub RunScenario(ByRef src1 As Range, ByRef dest1 As Range, _
             ByRef src2 As Range, ByRef dest2 As Range)
    dest1.Value = src1.Value
    '--- if the calculation mode is xlAutomatic (which is the
    '    usual default in Excel) then executing "Calculate"
    '    is not necessary
    dest2.Value = src2.Value
End Sub

Sub Main1()
    Dim scenarios As Worksheet
    Dim portfolios As Worksheet
    Set scenarios = ThisWorkbook.Worksheets("Scenarios")
    Set portfolios = ThisWorkbook.Worksheets("Portfolio Model")
    
    '--- Flat scenarios
    scenarios.Range("M2") = "Y"
    With portfolios
        RunScenario .Range("GO8"), .Range("G3"), .Range("GK5"), Range("GP8")
        RunScenario .Range("GO9"), .Range("G3"), .Range("GK5"), Range("GP9")
        RunScenario .Range("GO10"), .Range("G3"), .Range("GK5"), Range("GP10")
        RunScenario .Range("GO11"), .Range("G3"), .Range("GK5"), Range("GP11")
        RunScenario .Range("GO12"), .Range("G3"), .Range("GK5"), Range("GP12")
        RunScenario .Range("GO13"), .Range("G3"), .Range("GK5"), Range("GP13")
        RunScenario .Range("GO14"), .Range("G3"), .Range("GK5"), Range("GP14")
    End With
End Sub