如何创建逐笔处理贷款并输出至独立工作表的循环Excel宏？

我正在搭建贷款定价模型，需要宏逐笔处理贷款定价，并将结果逐行粘贴到Output工作表（不能覆盖已有内容）。用宏录制器生成了初始代码，只能处理前两笔贷款，不知道怎么改成循环直到遇到空白单元格。当前代码如下：

Sub Macro1()
'
' Macro1 Macro
'
'
    Selection.Copy
    Sheets("Cashflows").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Output").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Input").Select
    Range("A3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Cashflows").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Output").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

修改后的可循环处理宏代码 #

Sub ProcessLoans()
    Dim wsInput As Worksheet, wsCashflows As Worksheet, wsOutput As Worksheet
    Dim inputRow As Long, outputRow As Long
    
    ' 绑定工作表对象，避免频繁切换选择操作
    Set wsInput = ThisWorkbook.Sheets("Input")
    Set wsCashflows = ThisWorkbook.Sheets("Cashflows")
    Set wsOutput = ThisWorkbook.Sheets("Output")
    
    inputRow = 2 ' 假设第一笔贷款数据从Input表第2行（A2）开始
    ' 获取Output表最后一行的下一行，作为结果粘贴的起始行
    outputRow = wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 循环处理每一笔贷款，直到Input表A列出现空白单元格
    Do While wsInput.Cells(inputRow, "A").Value <> ""
        ' 将当前贷款数据复制到Cashflows的A3（仅粘贴值）
        wsInput.Cells(inputRow, "A").Resize(1, wsInput.Cells(inputRow, "A").End(xlToRight).Column).Copy
        wsCashflows.Range("A3").PasteSpecial Paste:=xlPasteValues
        
        ' 将Cashflows生成的定价结果复制到Output的空白行
        wsCashflows.Range("A3").Resize(1, wsCashflows.Range("A3").End(xlToRight).Column).Copy
        wsOutput.Cells(outputRow, "A").PasteSpecial Paste:=xlPasteValues
        
        ' 行号递增，准备处理下一笔贷款
        inputRow = inputRow + 1
        outputRow = outputRow + 1
        
        Application.CutCopyMode = False ' 清除剪贴板复制状态
    Loop
    
    MsgBox "所有贷款处理完成！", vbInformation
End Sub

关键修改说明 #

• 移除冗余的Select/Activate操作：录制宏生成的代码依赖大量选择操作，直接通过工作表对象操作单元格，不仅运行更快，还能避免因手动切换工作表导致的错误。
• 循环逻辑实现：使用Do While循环判断Input表A列当前单元格是否为空，为空则自动终止循环。
• 自动定位Output空白行：通过wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Row + 1自动找到Output表的下一个空白行，彻底避免内容覆盖。
• 动态适配数据列数：用Resize方法配合End(xlToRight)获取每行的有效数据长度，兼容不同字段数量的贷款数据。

内容的提问来源于stack exchange，提问作者amcook1989