Excel VBA遍历格式化表单并将数据追加至表格的循环实现咨询

原有代码的核心问题 #

1. 频繁使用Select/Selection操作，代码易出错且效率低下
2. 「VERIFY」部分重新查找目标行，导致后续列粘贴位置错位
3. 循环部分未定义rng变量，无明确循环数据源
4. 重复的复制粘贴代码冗余，可大幅简化

优化后的完整代码 #

Sub SubmitPlan()
    Dim wsInput As Worksheet
    Dim wsData As Worksheet
    Dim targetRow As Long
    
    ' 定义工作表变量，避免重复切换选择
    Set wsInput = ThisWorkbook.Sheets("Input")
    Set wsData = ThisWorkbook.Sheets("Input Data")
    
    ' 找到INPUT DATA表的下一个空行（从A列判断）
    targetRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 批量映射INPUT表单单元格到INPUT DATA的对应列
    With wsInput
        ' NAME -> A列
        wsData.Cells(targetRow, "A").Value = .Range("D7").Value
        ' HIREDATE -> B-C列（对应G7:H7两列）
        .Range("G7:H7").Copy
        wsData.Cells(targetRow, "B").PasteSpecial Paste:=xlPasteValues
        ' TRAINEETYPE -> D列
        wsData.Cells(targetRow, "D").Value = .Range("D10").Value
        ' VERIFY -> E列
        wsData.Cells(targetRow, "E").Value = .Range("B15").Value
        
        ' --- 处理剩余列的循环（按需修改）
        Dim inputRng As Range
        Dim cell As Range
        Dim colOffset As Integer
        
        ' 替换为你表单中剩余需要复制的横向单元格范围
        Set inputRng = .Range("D18:J18")
        ' 替换为INPUT DATA中接收这些数据的起始列号（比如F列是6）
        colOffset = 6
        
        For Each cell In inputRng
            wsData.Cells(targetRow, colOffset).Value = cell.Value
            colOffset = colOffset + 1
        Next cell
    End With
    
    ' 清除复制模式
    Application.CutCopyMode = False
    ' 可选：返回Input表并清空提交内容
    wsInput.Activate
    ' wsInput.Range("D7,G7:H7,D10,B15,D18:J18").ClearContents
End Sub

关键说明 #

1. 抛弃Select操作：直接通过工作表变量引用单元格，代码更稳定、运行更快
2. 统一目标行：提前定位INPUT DATA的下空行，所有数据都写入该行，避免错位
3. 剩余列循环适配：
   • 修改inputRng为你表单中需要循环复制的单元格区域
   • 调整colOffset为INPUT DATA中对应接收数据的起始列号
4. 高效赋值：单个单元格直接用.Value赋值，比复制粘贴更高效；多列范围（如日期）保留粘贴操作

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