如何将重复的VBA批量赋值代码精简为嵌套For循环提升健壮性

精简版可直接使用代码 #

Sub VIN_Decode()
    ' 可根据实际需求调整以下常量参数
    Const SHEET1_START_ROW As Long = 2 ' Sheet1读取起始行
    Const SHEET2_START_ROW As Long = 2 ' Sheet2写入起始行
    Const ROWS_PER_VALUE As Long = 20 ' 每个值对应Sheet2的行数
    
    Dim sheet1Row As Long
    Dim sheet2Start As Long
    Dim i As Long
    
    ' 遍历Sheet1 A列所有有数据的行
    sheet2Start = SHEET2_START_ROW
    For sheet1Row = SHEET1_START_ROW To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
        ' 给Sheet2对应区间赋值
        For i = sheet2Start To sheet2Start + ROWS_PER_VALUE - 1
            Sheet2.Cells(i, 1) = Sheet1.Cells(sheet1Row, 1)
        Next
        ' 计算下一个区间的起始行
        sheet2Start = sheet2Start + ROWS_PER_VALUE
    Next
End Sub

逻辑说明 #

• 固定参数全部定义为常量，后续需要调整读取起始行、写入起始行、每个值对应行数时，直接修改常量即可，无需改动核心逻辑
• 外层循环自动遍历Sheet1 A列所有有内容的行，无需手动为每一行Sheet1数据单独写循环，哪怕处理上千行数据也可以自动完成
• 自动计算Sheet2的写入区间，避免手动计算行号出错

大数据量高效版本 #

如果处理的数据量极大，可改用数组批量赋值，避免逐单元格读写，运行速度会提升数倍：

Sub VIN_Decode_HighSpeed()
    Const SHEET1_START_ROW As Long = 2
    Const SHEET2_START_ROW As Long = 2
    Const ROWS_PER_VALUE As Long = 20
    
    Dim sheet1Data As Variant
    Dim sheet2Data As Variant
    Dim lastRow1 As Long
    Dim i As Long, j As Long, k As Long
    
    ' 一次性读取Sheet1所有A列数据到数组
    lastRow1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    sheet1Data = Sheet1.Range("A" & SHEET1_START_ROW & ":A" & lastRow1).Value
    
    ' 提前构造Sheet2需要写入的数组
    ReDim sheet2Data(1 To (lastRow1 - SHEET1_START_ROW + 1) * ROWS_PER_VALUE, 1 To 1)
    k = 1
    For i = 1 To UBound(sheet1Data, 1)
        For j = 1 To ROWS_PER_VALUE
            sheet2Data(k, 1) = sheet1Data(i, 1)
            k = k + 1
        Next
    Next
    
    ' 一次性写入Sheet2
    Sheet2.Range("A" & SHEET2_START_ROW & ":A" & SHEET2_START_ROW + UBound(sheet2Data, 1) - 1).Value = sheet2Data
End Sub

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