如何用循环优化Excel VBA中Offset单元格的重复赋值代码？

核心思路 #

将S4-01到S4-12的固定序列转化为循环变量，通过格式化字符串自动生成对应标识，统一处理数据赋值逻辑，彻底消除冗余的IF分支。

优化后代码示例 #

Sub TransferData()
    Dim bws As Worksheet, dws As Worksheet
    Dim i As Integer
    Dim sourceRow As Range
    Dim targetRange As Range
    Dim searchKey As String
    
    ' 替换为你的实际工作表名称
    Set bws = ThisWorkbook.Worksheets("源工作表")
    Set dws = ThisWorkbook.Worksheets("目标工作表")
    
    ' 循环处理S4-01至S4-12
    For i = 1 To 12
        ' 自动生成带补零的标识（i=1→"S4-01"，i=10→"S4-10"）
        searchKey = "S4-" & Format(i, "00")
        
        ' 在源表V列精确查找标识对应的行
        Set sourceRow = bws.Columns("V").Find(What:=searchKey, LookIn:=xlValues, LookAt:=xlWhole)
        
        ' 找到匹配行后执行数据赋值
        If Not sourceRow Is Nothing Then
            ' 目标区域：dws的E列，每个标识对应4行连续区域（起始行可根据实际需求调整）
            Set targetRange = dws.Cells((i - 1) * 4 + 2, "E").Resize(4, 1)
            ' 把源表AB-AE列的横向数据转纵向，赋值到目标区域
            targetRange.Value = Application.Transpose(sourceRow.Offset(0, 6).Resize(1, 4).Value)
        End If
    Next i
End Sub

关键细节说明 #

• 自动补零的标识生成：Format(i, "00")可以自动将1-9转为"01"-"09"，无需额外判断，简化标识拼接逻辑。
• 高效定位匹配行：用Find方法替代逐行遍历，大幅提升查找效率；LookAt:=xlWhole确保只匹配完全一致的标识。
• 批量数据赋值：通过Transpose将源表中AB-AE的横向4列数据转为纵向，直接赋值比Copy/Paste操作更快且更稳定。
• 容错处理：加入If Not sourceRow Is Nothing判断，避免因找不到标识导致代码报错。

自定义调整点 #

• 若目标区域的起始位置不是按4行递增，可修改(i - 1) * 4 + 2的计算逻辑，比如改为固定起始行加对应偏移量。
• 若源数据列不是AB-AE，调整Offset(0, 6)的参数：V列是第22列，AB是第28列，两者差值为6；如果是其他列，计算对应列的偏移量即可。

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