VBA实现按重复值横向打印对应第2列相邻单元格值需求及代码修正

需求：根据某列的重复值，将对应第2列的相邻单元格值横向排列。即当某一数值多次重复时，将其对应的第2列值横向输出，再处理下一组重复值。现有VBA代码未达到预期效果，需修正。

原代码存在的问题：

• 分组逻辑模糊，未明确判断分组的起始与结束条件
• 未按需求横向递增输出列（d变量未正确触发递增）
• 手动修改循环变量k易导致遍历遗漏
• 未处理最后一组数据的输出

修正后的VBA代码 #

Sub TransposeDuplicateValues()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentGroup As Variant
    Dim outputRow As Integer
    Dim outputCol As Integer
    Dim i As Long
    
    ' 指定目标工作表（第5个工作表，可按需调整）
    Set ws = ThisWorkbook.Worksheets(5)
    ' 自动获取数据最后一行（避免硬编码行数）
    lastRow = ws.Cells(ws.Rows.Count, 12).End(xlUp).Row
    ' 初始化输出位置：起始行2，起始列18
    outputRow = 2
    outputCol = 18
    
    ' 初始化首个分组并写入第一个值
    currentGroup = ws.Cells(2, 12).Value
    ws.Cells(outputRow, outputCol).Value = ws.Cells(2, 2).Value
    outputCol = outputCol + 1
    
    ' 遍历后续数据行
    For i = 3 To lastRow
        ' 判断当前行是否属于当前分组（按第12列的值分组）
        If ws.Cells(i, 12).Value = currentGroup Then
            ' 同一组：横向写入第2列的值
            ws.Cells(outputRow, outputCol).Value = ws.Cells(i, 2).Value
            outputCol = outputCol + 1
        Else
            ' 切换新分组：重置输出列，递增输出行，写入新分组第一个值
            outputRow = outputRow + 1
            outputCol = 18
            currentGroup = ws.Cells(i, 12).Value
            ws.Cells(outputRow, outputCol).Value = ws.Cells(i, 2).Value
            outputCol = outputCol + 1
        End If
    Next i
End Sub

关键改进说明 #

1. 明确分组逻辑：按第12列的值作为分组依据（若需修改分组列，替换代码中12为目标列号即可）
2. 动态输出位置：同一组内递增列号实现横向排列，切换分组时重置列号并递增行号
3. 自动适配数据范围：通过lastRow自动获取数据最后一行，避免硬编码导致的错误
4. 完整遍历数据：不手动修改循环变量，确保所有行都被处理，包括最后一组数据

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