主页 / coding / 问题 / 79168115
Accepted
DR21
Asked: 2024-11-08 05:21:45 +0800 CST

使用多个数组进行循环

  • 772

我无法创建一个有效的代码，该代码循环并返回从特定单元格开始的 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
arrays

3 个回答

  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
    • 2

  2. 只要看一下你的第一个列表，你就可以像这样循环：

    Sub Tester()

    Dim wsScen As Worksheet, wsPM As Worksheet
    Dim i As Long
    
    Set wsScen = ThisWorkbook.Worksheets("Scenarios")
    Set wsPM = ThisWorkbook.Worksheets("Portfolio Model")
    
    'Run Flat Scenarios
    wsScen.Range("M2").Value = IIf(wsScen.Range("M2").Value = "N", "Y", "N")
    
    For i = 8 To 14
        wsPM.Range("G3").Value = wsPM.Cells(i, "GO").Value
        Calculate
        wsPM.Cells(i, "GP").Value = wsPM.Range("GK5").Value
    Next i

End Sub
    • 2
  3. Best Answer

    改进宏录制器代码：编码场景

    从单元格读取

    • 这里场景的数量由一个常数定义。
    • GO:GP此外，还使用表示列偏移量的常数 ( )。
    Sub Macro1()

    ' Define constants.
    Const SCENARIOS_COUNT As Long = 7
    Const COLUMN_OFFSET As Long = 1

    ' Reference the workbook and worksheets.
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' If it isn't, reference it by its name or use 'ActiveWorkbook'.

    Dim sws As Worksheet: Set sws = wb.Sheets("Scenarios")
    Dim pws As Worksheet: Set pws = Sheets("Portfolio Model")
    
    'Run Flat Scenarios
    
    With sws.Range("M2")
        If .Value = "N" Then .Value = "Y" Else .Value = "N" ' !?!
    End With
                
    With pws
        Dim fcell As Range: Set fcell = .Range("GO8")
        Dim RowOffset As Long
        For RowOffset = 0 To SCENARIOS_COUNT - 1
            .Range("G3").Value = fcell.Offset(RowOffset).Value
            .Calculate
            fcell.Offset(RowOffset, COLUMN_OFFSET).Value = .Range("GK5").Value
        Next RowOffset
    End With
    
End Sub

    从数组读取

    • 这里场景的数量由数组中元素的数量定义。
    • 由于第一个单元格位于列中，因此不需要列偏移量常量GP。中的值GO将被数组中的值替换。
    Sub Macro2()

    ' Define constants.
    Dim VALUES() As Variant: VALUES = VBA.Array( _
        0.085, 0.0875, 0.09, 0.0925, 0.095, 0.0975, 0.01)

    ' Reference the workbook and worksheets.
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' If it isn't, reference it by its name or use 'ActiveWorkbook'.

    Dim sws As Worksheet: Set sws = wb.Sheets("Scenarios")
    Dim pws As Worksheet: Set pws = Sheets("Portfolio Model")
    
    'Run Flat Scenarios
    
    With sws.Range("M2")
        If .Value = "N" Then .Value = "Y" Else .Value = "N" ' !?!
    End With
                
    With pws
        Dim fcell As Range: Set fcell = .Range("GP8")
        Dim Index As Long
        For Index = 0 To UBound(VALUES)
            .Range("G3").Value = VALUES(Index)
            .Calculate
            fcell.Offset(Index).Value = .Range("GK5").Value
        Next Index
    End With
    
End Sub
    • 2

相关问题