Excel VBA双层循环数据填充需求问询：B列匹配与循环重置

• Loop01：遍历B列查找值"x"，以此位置作为下一轮循环的起点
• Loop02：遍历B列，若值匹配D1至J1的表头内容，则将对应行A列的"data"值填入第2行及后续行的D、E等对应列；若Loop02找到"x"，则在新行重新启动Loop02

Sub Test()
Dim N As Long, i As Long, i2 As Long, j As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
j = 2
LD = Sheet1.Range("D1").Value
LE = Sheet1.Range("E1").Value
LF = Sheet1.Range("F1").Value
LG = Sheet1.Range("G1").Value
LH = Sheet1.Range("H1").Value
LI = Sheet1.Range("I1").Value
LJ = Sheet1.Range("J1").Value

For i = 2 To N
    If Cells(i, "B").Value = "x" Then
    i = i + 1
        For i2 = 2 To N
            If Cells(i, "B").Value = "x" Then
                i = i - 1
                j = j + 1
                Exit For
            End If
            If Cells(i, "B").Value = LD Then
                Cells(j, "D").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LE Then
                Cells(j, "E").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LF Then
                Cells(j, "F").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LG Then
                Cells(j, "G").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LH Then
                Cells(j, "H").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LI Then
                Cells(j, "I").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LJ Then
                Cells(j, "J").Value = Cells(i, "A").Value
            End If
            i = i + 1
        Next i2
    End If
Next i
End Sub

1. 循环变量冲突：外层循环的i被内层循环直接修改，会导致外层循环遍历逻辑混乱，出现跳行或重复处理的问题
2. 无效变量定义：内层循环的i2变量未被实际使用，属于冗余定义，循环推进完全依赖修改i，逻辑不严谨
3. 变量类型缺失：LD、LE等变量未声明类型，默认是Variant，可能引发类型匹配错误
4. 工作表未限定：Cells、Rows.Count等操作未指定工作表，默认使用当前激活表，易因表切换产生错误
5. 代码冗余度高：多个独立的If判断重复度高，后续新增列时需要大量修改代码

Sub ProcessData()
    Dim ws As Worksheet
    Dim lastRow As Long, currentRow As Long, outputRow As Long
    Dim headerMap As Object
    Dim cellValue As String
    
    ' 指定操作工作表，避免依赖激活表
    Set ws = Sheet1
    Set headerMap = CreateObject("Scripting.Dictionary")
    
    ' 构建B列值与输出列的映射关系
    headerMap(ws.Range("D1").Value) = "D"
    headerMap(ws.Range("E1").Value) = "E"
    headerMap(ws.Range("F1").Value) = "F"
    headerMap(ws.Range("G1").Value) = "G"
    headerMap(ws.Range("H1").Value) = "H"
    headerMap(ws.Range("I1").Value) = "I"
    headerMap(ws.Range("J1").Value) = "J"
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    outputRow = 2 ' 输出起始行
    
    currentRow = 2
    Do While currentRow <= lastRow
        ' 定位分组起点"x"
        If ws.Cells(currentRow, "B").Value = "x" Then
            currentRow = currentRow + 1 ' 跳过"x"行，开始处理分组内数据
            
            ' 处理当前分组，直到遇到下一个"x"或数据末尾
            Do While currentRow <= lastRow And ws.Cells(currentRow, "B").Value <> "x"
                cellValue = ws.Cells(currentRow, "B").Value
                ' 若当前值存在映射，写入对应输出列
                If headerMap.Exists(cellValue) Then
                    ws.Cells(outputRow, headerMap(cellValue)).Value = ws.Cells(currentRow, "A").Value
                End If
                currentRow = currentRow + 1
            Loop
            
            ' 切换到下一行输出
            outputRow = outputRow + 1
        Else
            currentRow = currentRow + 1
        End If
    Loop
End Sub

• 逻辑清晰化：使用Do While循环替代嵌套For循环，避免修改外层循环变量，分组处理逻辑更直观
• 映射关系简化：用字典存储表头映射，减少冗余If判断，后续新增列只需添加字典条目即可
• 工作表锁定：全程指定操作工作表，避免因激活表切换导致的错误
• 变量规范化：所有变量均声明具体类型，避免Variant类型的潜在问题
• 可读性提升：变量命名语义化，比如currentRow、outputRow，便于理解和维护

内容的提问来源于stack exchange，提问作者Carly Carlyle Adams Cnf