如何修改Excel VBA代码实现多账户输入数据批量汇总至目标工作表

我在Excel中设置了一个用户输入界面：

• B1、B2为用户输入单元格，已命名为FN、LN
• A4及以下为无行数限制的账户输入区域（用户可输入3个或更多账户）

需求是点击提交按钮后，将数据汇总到另一工作表Sheet2：账户数据分行展示，FN、LN的姓名信息对应每个账户重复填充。

目前仅实现了单账户提交的基础功能，现有VBA代码如下：

Private Sub data_input() 

ws_output = "Sheet2" 
next_row = Sheets(ws_output).Cells(Rows.Count, 1).End(xlUp).Offset(1).Row 
Sheets(ws_output).Cells(next_row, 1).Value = Range("FN").Value
Sheets(ws_output).Cells(next_row, 2).Value = Range("LN").Value 
Sheets(ws_output).Cells(next_row, 3).Value = Range("A_1").Value 

End Sub

该代码无法自动识别账户输入行数并批量处理，求修改方案。

Private Sub data_input()
    Dim ws_input As Worksheet
    Dim ws_output As Worksheet
    Dim last_account_row As Long
    Dim account_range As Range
    Dim cell As Range
    Dim next_output_row As Long
    
    ' 定义输入和输出工作表
    Set ws_input = ThisWorkbook.ActiveSheet ' 若输入界面固定在某工作表，可改为Sheets("你的输入表名")
    Set ws_output = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取A列最后一个有数据的账户行（从A4开始统计）
    last_account_row = ws_input.Cells(Rows.Count, "A").End(xlUp).Row
    ' 若A4及以下无有效账户数据，直接退出程序
    If last_account_row < 4 Then Exit Sub
    
    ' 划定账户数据的范围：A4到最后一行有数据的单元格
    Set account_range = ws_input.Range("A4:A" & last_account_row)
    
    ' 获取输出工作表的下一个空行起始位置
    next_output_row = ws_output.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    
    ' 循环遍历每个账户单元格，批量写入数据
    For Each cell In account_range
        ' 跳过空单元格，避免写入无效数据
        If Trim(cell.Value) <> "" Then
            ws_output.Cells(next_output_row, 1).Value = ws_input.Range("FN").Value
            ws_output.Cells(next_output_row, 2).Value = ws_input.Range("LN").Value
            ws_output.Cells(next_output_row, 3).Value = cell.Value
            next_output_row = next_output_row + 1 ' 移动到下一个待写入的空行
        End If
    Next cell
End Sub

• 明确工作表对象：使用Set指定输入输出工作表，避免因当前激活工作表切换导致的数据写入错误
• 自动识别账户范围：通过Cells(Rows.Count, "A").End(xlUp).Row动态获取A列最后一个有数据的行，结合A4确定完整的账户输入区域
• 批量循环处理：用For Each遍历每个账户单元格，跳过空单元格过滤无效输入，每次处理后更新输出行号，确保数据连续写入
• 姓名重复填充：在循环体内重复写入FN和LN的值，实现每个账户行都对应相同的姓名信息

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