VBA实现不定数量空行分隔的不定长数据块自动转置方案求助

实现逻辑 #

• 遍历A列所有数据行，自动跳过连续空行
• 将连续的非空内容归集为同一个信息块
• 每识别完一个完整信息块，就将块内内容横向转置写入输出区域
• 最后自动处理收尾的最后一个信息块

完整VBA代码 #

Sub 按空行分块转置()
    Dim nlr As Long, i As Long, outputRow As Long
    Dim currentBlock As Variant, blockIndex As Integer
    
    ' 获取A列最后一行有数据的行号
    nlr = Cells(Rows.Count, "A").End(xlUp).Row
    ' 初始化输出起始行，可根据需要修改，这里从第2行开始对应表头行
    outputRow = 2
    ' 初始化块存储数组，最大支持单个块100行内容，可按需调整
    ReDim currentBlock(0 To 99)
    blockIndex = 0
    
    For i = 2 To nlr ' 这里从第2行开始遍历，若没有表头改为i=1即可
        If Range("A" & i).Value <> "" Then
            ' 非空内容加入当前块
            currentBlock(blockIndex) = Range("A" & i).Value
            blockIndex = blockIndex + 1
        Else
            ' 遇到空行且当前块有内容，输出块
            If blockIndex > 0 Then
                ' 转置写入输出区域，默认从I列开始输出，可修改9调整起始列号
                Range(Cells(outputRow, 9), Cells(outputRow, 8 + blockIndex)) = currentBlock
                ' 重置块参数
                Erase currentBlock
                ReDim currentBlock(0 To 99)
                blockIndex = 0
                outputRow = outputRow + 1
            End If
        End If
    Next i
    
    ' 处理最后一个没有被空行触发输出的块
    If blockIndex > 0 Then
        Range(Cells(outputRow, 9), Cells(outputRow, 8 + blockIndex)) = currentBlock
    End If
    
    ' 可选：自动调整输出列宽度
    Columns("I:L").AutoFit
End Sub

使用说明 #

• 如果你的数据没有表头，把代码中For i = 2 To nlr改为For i = 1 To nlr即可
• 如果需要修改输出的起始列，修改代码中列号参数即可，比如I列是9，J列是10以此类推
• 如果单个信息块的行数超过100，修改ReDim currentBlock(0 To 99)的上限数值即可

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