Excel横向分组表格转纵向分组表格VBA实现需求

适用场景 #

待转换的横向表格具备以下特征：

• 仅含一个表头，无需转换表头内容
• 数据按每组34列分组，组与组之间存在空白列分隔
• 每组的有效行数不固定

转换后的数据将自动追加到「Master」工作表A列的首个可用单元格（即A列底部）。

VBA实现代码 #

Sub HorizontalToVerticalGroups()
    Dim srcWS As Worksheet
    Dim destWS As Worksheet
    Dim lastCol As Long, lastRow As Long
    Dim colStart As Long, colEnd As Long
    Dim destRow As Long
    Dim i As Long, j As Long
    
    ' 定义源表（当前活动工作表）和目标表
    Set srcWS = ActiveSheet
    Set destWS = ThisWorkbook.Worksheets("Master")
    
    ' 获取Master表A列的首个空白行
    destRow = destWS.Cells(destWS.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 获取源表最后一列的位置
    lastCol = srcWS.Cells(1, srcWS.Columns.Count).End(xlToLeft).Column
    
    colStart = 1
    ' 循环处理每一组数据列
    Do While colStart <= lastCol
        ' 跳过组间的空白列
        If srcWS.Cells(1, colStart).Value = "" Then
            colStart = colStart + 1
            GoTo NextGroup
        End If
        
        ' 确定当前组的结束列（每组34列）
        colEnd = colStart + 33
        If colEnd > lastCol Then colEnd = lastCol
        
        ' 获取当前组的有效数据最后一行
        lastRow = srcWS.Cells(srcWS.Rows.Count, colStart).End(xlUp).Row
        
        ' 遍历当前组的每一行（跳过表头，从第2行开始）
        For i = 2 To lastRow
            ' 遍历当前组的每一列，写入Master表
            For j = colStart To colEnd
                If srcWS.Cells(i, j).Value <> "" Then
                    destWS.Cells(destRow, "A").Value = srcWS.Cells(i, j).Value
                    destRow = destRow + 1
                End If
            Next j
        Next i
        
        ' 移动到下一组的起始列
        colStart = colEnd + 1
NextGroup:
    Loop
    
    MsgBox "转换完成，数据已追加到Master表A列底部！", vbInformation
End Sub

代码说明 #

1. 表定位：默认以当前激活的工作表作为横向数据的来源，目标固定指向「Master」工作表
2. 目标行计算：通过End(xlUp)快速定位A列最后一个非空单元格，下一行即为数据追加的起始位置
3. 组列处理：自动识别组间的空白列并跳过，每组按34列的范围处理，若最后一组不足34列则自动适配
4. 数据转换逻辑：跳过表头行，将每组的每行数据按列依次转成纵向单行，同时跳过源表中的空白单元格，避免目标表出现无效空行
5. 完成提示：转换结束后弹出提示框告知结果

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