excel VBA'循环时'的问题。似乎无法找到结束循环的布尔值

Question

大家早上好。我正在构建一个项目财务模型，该模型需要我通过使用复制/粘贴循环表来打破一些循环。

现在，我正在使用代码，其中需要“Fin 语句”选项卡中的一个单元格在循环切断之前转到 True。但由于某种原因它不起作用。我需要你的帮助来修复代码。

Sub Cir_Reinvestment()
'
' Cir_Reinvestment Macro
    
' For Scenario 1
    
    Dim I As Long
    Dim Rngcashchk As Boolean

    'Cell where sheet checks for True/False statement
    Rngcashchk = Sheets("Fin Statements").Cells(105, E)
    


    'Copy Paste Actions start here
    
    Sheets("Inputs").Select
    Range("Macro.Cashflow.Closing.Copy").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("Macro.Cashflow.Closing.Paste").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Inputs").Select
    Range("MacroRS.Invested.Fund.Copy").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("MacroRS.Invested.Fund.Paste").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("MacroRS.REIncome.Copy").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("MacroRS.REIncome.Paste").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("Macro.Cashflow.Closing.Copy").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("Macro.Cashflow.Closing.Paste").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
'Loop should end once Cell is True

 Loop Until Rngcashchk = True

End Sub

Answer 1

1. 我在Loop Until 前面没有看到关键字Do
2. 顺便说一句，在复制/粘贴之前选择一个范围是不必要的。你可以这样做： Range("A1").Copy Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
3. 您可以在所有复制粘贴进度结束时拨打Application.CutCopyMode = False一次

Answer 2

由于我不确切知道什么不起作用，因此很难为您提供帮助。
但这里有一个关于如何编写代码的建议，如果它始终遵循与命名范围相同的模式，如示例所示。
由于我们多次执行相同的操作，因此我将其分解为一个单独的子循环，我们可以从主循环中调用它。
但我会不建议运行此代码，因为没有什么可以阻止 ot 永远循环。因此，我暂时将循环注释掉了。

Sub Cir_Reinvestment()
  Dim Rngcashchk As Boolean
  Rngcashchk = Sheets("Fin Statements").Cells(105, "E")

  'Do
      CopyPaste ("Macro.Cashflow.Closing")
      CopyPaste ("MacroRS.Invested.Fund")
      CopyPaste ("MacroRS.REIncome")
  'Loop Until Rngcashchk

End Sub


Sub CopyPaste(rng As String)

  Sheets("Inputs").Range(rng & ".Copy", Range(rng & ".Copy").End(xlToRight)).copy
  Sheets("Inputs").Range(rng & ".Paste").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone

End Sub

Answer 3

圆形

• 未经测试（希望CashChk 会变成True）。
• 重新考虑是否真的需要将第一个范围复制两次（在循环的开头和之后）。

守则

Option Explicit

Sub Cir_Reinvestment()
'
' Cir_Reinvestment Macro
    
' For Scenario 1
    
    Dim CopyRanges As Variant
    CopyRanges = Array("Macro.Cashflow.Closing.Copy", _
        "MacroRS.Invested.Fund.Copy", "Macro.Cashflow.Closing.Copy")
    Dim PasteRanges As Variant
    PasteRanges = Array("Macro.Cashflow.Closing.Paste", _
        "MacroRS.Invested.Fund.Paste", "Macro.Cashflow.Closing.Paste")
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim First As Long: First = LBound(CopyRanges)
    Dim Last As Long: Last = UBound(CopyRanges)
    Dim crg As Variant: ReDim crg(First, Last)
    Dim prg As Variant: ReDim prg(First, Last)
    
    Dim n As Long
    With wb.Worksheets("Inputs")
        For n = First To Last
            With .Range(CopyRanges(n))
                Set crg(n) = .Parent.Range(.Offset, .End(xlToRight))
            End With
            With .Range(PasteRanges(n))
                Set prg(n) = .Resize(crg(n).Rows.Count, crg(n).Columns.Count)
            End With
        Next n
    End With
    
    Dim cashRg As Range
    Set cashRg = wb.Worksheets("Fin Statements").Cells(105, "E")
    
    Dim CashChk As Boolean
    Do
        CashChk = cashRg.Value
        For n = First To Last
            prg(n).Value = crg(n).Value
        Next n
        prg(First).Value = crg(First).Value
    Loop Until CashChk = True

End Sub