如何用1行VBA代码替代百行复制+修复A列自动填充至B列末行问题

问题1：批量复制跨列数据替代重复代码 #

可以通过Range区域批量赋值实现一行代码完成100个单元格的复制，无需逐个单元格写赋值语句。核心逻辑：

• 定位Sh2中待复制的区域：Sh2.Range("G19:DG19")
• 定位Sh1中目标区域：对应行的T列起始，用Resize匹配源区域的列数，即Sh1.Cells(rng.Row, "T").Resize(1, Sh2.Range("G19:DG19").Columns.Count)
• 直接将源区域的值赋值给目标区域，避免循环冗余。

同时，原VLOOKUP的重复代码也可优化：J-S列对应Sh2的9-18列（连续区域），可一次性获取结果批量写入，减少代码量。

问题2：A列自动填充至B列最后一行 #

原代码错误在于Autofill的目标区域字符串拼接格式错误，且无需使用Select操作。正确实现：

• 定位A列最后有值的单元格：Sh1.Cells(Last_Row2, "A")
• 定义填充目标范围：从A列最后一行到B列最后一行的A列区域，即Sh1.Range(Sh1.Cells(Last_Row2, "A"), Sh1.Cells(Last_Row, "A"))
• 使用AutoFill方法并指定填充类型（如递增序列xlFillSeries），直接操作Range对象无需选中单元格。

优化后的完整代码 #

Sub Autofill()
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Dim rng As Range
    Dim Last_Row As Long
    Dim Last_Row2 As Long
    Dim vlookupResult As Variant
    
    ' 初始化工作表对象
    Set Sh1 = Sheets("Certificates")
    Set Sh2 = Sheets("Codes")
    
    ' 获取最后行号（用Long避免行数超出Single范围）
    Last_Row = Sh1.Range("B" & Sh1.Rows.Count).End(xlUp).Row
    Last_Row2 = Sh1.Range("A" & Sh1.Rows.Count).End(xlUp).Row
    
    ' 遍历B列数据
    For Each rng In Sh1.Range("B2:B" & Last_Row)
        If rng.Value > 0 And Sh1.Cells(rng.Row, "E").Value = 0 Then
            ' 单个VLOOKUP赋值（E、F列对应Sh2的4、5列，非连续）
            Sh1.Cells(rng.Row, "E").Value = Application.VLookup(rng.Value, Sh2.Range("$A$2:$R$15000"), 4, 0)
            Sh1.Cells(rng.Row, "F").Value = Application.VLookup(rng.Value, Sh2.Range("$A$2:$R$15000"), 5, 0)
            
            ' 批量填充J-S列（对应Sh2的9-18列，连续区域）
            vlookupResult = Application.VLookup(rng.Value, Sh2.Range("$A$2:$R$15000"), Array(9, 10, 11, 12, 13, 14, 15, 16, 17, 18), 0)
            If Not IsError(vlookupResult) Then
                Sh1.Cells(rng.Row, "J").Resize(1, 10).Value = vlookupResult
            End If
            
            ' 一行代码完成Sh2第19行G-DG列到Sh1对应行T-DT列的复制
            Sh1.Cells(rng.Row, "T").Resize(1, Sh2.Range("G19:DG19").Columns.Count).Value = Sh2.Range("G19:DG19").Value
        End If
    Next rng
    
    ' 自动填充A列从最后有值行到B列最后一行
    If Last_Row > Last_Row2 Then
        Sh1.Cells(Last_Row2, "A").AutoFill _
            Destination:=Sh1.Range(Sh1.Cells(Last_Row2, "A"), Sh1.Cells(Last_Row, "A")), _
            Type:=xlFillSeries
    End If
End Sub

关键改动说明 #

1. 批量复制跨列数据：
   • 用Resize(1, 列数)匹配源区域列数，直接赋值Value，效率远高于逐个单元格赋值。
2. VLOOKUP批量优化：
   • 针对连续目标列，用Array(9,10,...18)一次性获取多列VLOOKUP结果，批量写入单元格，减少重复调用次数。
3. A列填充修复：
   • 修正目标区域拼接错误，直接用Range对象定义范围，避免Select操作（VBA中应尽量避免Select，提升效率和稳定性）。
   • 增加If Last_Row > Last_Row2判断，避免无效填充。
4. 数据类型优化：
   • 将行号变量类型从Single改为Long，避免行数超过65536时出现溢出错误（Excel支持百万行以上，Single范围不足）。

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