如何基于单元格值选择工作表与表格，用VBA实现伪表单数据录入？

看起来你遇到的核心问题是代码里硬编码了目标工作表名称，而且没有处理不同账户对应的独立表格区域。我帮你重构代码，实现动态匹配选择的Bank和Account，把数据写入对应工作表里对应账户表格的首个空行。

问题分析 #

原代码里Worksheets("Banca_1")是固定值，没有用到你获取的BANK变量；同时也没有逻辑去定位ACCOUNT对应的表格区域，所以只能往固定位置写数据。另外原代码里还有个拼写错误：OPERAZIONI应该是你定义的OPERAZIONE变量。

修正后的完整代码 #

Sub InserisciOperazione()
    Dim DATA As Date
    Dim ACCOUNT As String
    Dim BANK As String
    Dim OPERAZIONE As String
    Dim DARE As Currency
    Dim AVERE As Currency
    Dim targetSheet As Worksheet
    Dim accountTableHeaderRow As Integer
    Dim firstEmptyRow As Integer
    
    ' 从Home工作表的伪表单获取数据
    With Sheets("Home")
        DATA = .Cells(13, 1).Value
        ACCOUNT = .Cells(13, 2).Value
        BANK = .Cells(13, 3).Value
        OPERAZIONE = .Cells(13, 4).Value
        DARE = .Cells(13, 5).Value
        AVERE = .Cells(13, 6).Value
    End With
    
    ' 检查目标银行工作表是否存在，避免报错
    On Error Resume Next
    Set targetSheet = ThisWorkbook.Worksheets(BANK)
    On Error GoTo 0
    If targetSheet Is Nothing Then
        MsgBox "Errore: La worksheet '" & BANK & "' non esiste!", vbExclamation
        Exit Sub
    End If
    
    ' 定位对应Account表格的表头行（假设表头在第2列，值为账户名称）
    accountTableHeaderRow = 0
    For i = 1 To targetSheet.Cells(Rows.Count, 2).End(xlUp).Row
        If targetSheet.Cells(i, 2).Value = ACCOUNT Then
            accountTableHeaderRow = i
            Exit For
        End If
    Next i
    
    ' 如果找不到对应账户的表格，提示错误
    If accountTableHeaderRow = 0 Then
        MsgBox "Errore: Il tabellone per '" & ACCOUNT & "' non è stato trovato in '" & BANK & "'!", vbExclamation
        Exit Sub
    End If
    
    ' 找到该账户表格的首个空行（表头下的最后一行数据+1）
    firstEmptyRow = targetSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
    ' 确保空行在表头下方，避免覆盖表头
    If firstEmptyRow <= accountTableHeaderRow Then
        firstEmptyRow = accountTableHeaderRow + 1
    End If
    
    ' 将数据写入目标位置
    With targetSheet
        .Cells(firstEmptyRow, 2).Value = DATA
        .Cells(firstEmptyRow, 3).Value = ACCOUNT
        .Cells(firstEmptyRow, 4).Value = BANK
        .Cells(firstEmptyRow, 5).Value = OPERAZIONE
        .Cells(firstEmptyRow, 6).Value = DARE
        .Cells(firstEmptyRow, 7).Value = AVERE
    End With
    
    MsgBox "Ok! Operazione aggiunta con successo", vbInformation
End Sub

代码关键改动说明 #

1. 动态匹配银行工作表：用targetSheet = ThisWorkbook.Worksheets(BANK)替代硬编码的工作表名称，自动对应你选择的银行。
2. 账户表格定位：通过遍历目标工作表的第2列，找到对应账户的表头行，确保数据写入正确的账户表格区域（如果你的表格结构不同，可以调整查找的列或判断逻辑）。
3. 错误预防：增加了工作表和账户表格的存在性检查，避免因输入错误导致代码崩溃。
4. 空行精准定位：用End(xlUp)找到表格的最后一行数据，确保数据写入首个空行，不会覆盖已有内容。

适配调整提示 #

如果你的账户表格结构不是通过表头匹配（比如每个账户的表格在固定列区域），可以修改accountTableHeaderRow的定位逻辑，比如指定每个账户对应的起始列或行范围。

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