如何通过VBA将横向单元格区域簇转换为纵向排列

嗨，我来帮你搞定这个问题！你想要把横向排列的几组单元格区域（比如B2:C4、D2:E4、F2:G4）转成纵向堆叠的形式（B2:C4、B5:C7、B8:C10），用VBA就能完美实现，比单纯用转置函数灵活多了，我给你两种方案，按需选择~

方案一：手动指定区域簇（适合少量固定场景） #

如果你的区域簇数量不多、位置固定，用这个简单直接的宏就可以：

1. 打开Excel后按Alt+F11打开VBA编辑器
2. 在左侧工程窗口右键点击你的工作簿→插入→模块
3. 粘贴下面的代码：

Sub TransposeHorizontalClustersToVertical()
    Dim ws As Worksheet
    Dim sourceClusters As Variant
    Dim targetStart As Range
    Dim i As Integer
    Dim offsetRows As Integer
    
    ' 替换成你的实际工作表名称，比如"销售数据"
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 把需要处理的横向区域簇按顺序放进数组
    sourceClusters = Array(ws.Range("B2:C4"), ws.Range("D2:E4"), ws.Range("F2:G4"))
    ' 设置纵向堆叠的起始位置，这里是B2，也可以改成其他空白区域比如ws.Range("H2")
    Set targetStart = ws.Range("B2")
    
    offsetRows = 0 ' 初始偏移行数为0
    
    ' 逐个复制区域簇到目标位置
    For i = LBound(sourceClusters) To UBound(sourceClusters)
        sourceClusters(i).Copy Destination:=targetStart.Offset(offsetRows, 0)
        ' 每次偏移行数等于当前区域簇的行数，实现纵向堆叠
        offsetRows = offsetRows + sourceClusters(i).Rows.Count
    Next i
End Sub

4. 把代码里的工作表名称和区域簇范围改成你实际的情况
5. 按F5运行宏，或者回到Excel界面，点击开发工具→宏→选择TransposeHorizontalClustersToVertical执行

小提示：如果不想覆盖原有的源数据，直接把targetStart改成空白区域即可，比如ws.Range("H2")。

方案二：自动识别区域簇（适合大量簇的场景） #

如果你有很多横向排列的区域簇（比如每隔2列就有一个3行的簇），手动写数组太麻烦，这个自动识别的宏会更高效：

Sub AutoDetectAndTransposeClusters()
    Dim ws As Worksheet
    Dim currentCol As Integer
    Dim targetStart As Range
    Dim offsetRows As Integer
    Dim clusterCols As Integer
    Dim clusterRows As Integer
    
    ' 替换为你的实际工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    clusterCols = 2 ' 每个簇的列数（你的场景是2列）
    clusterRows = 3 ' 每个簇的行数（你的场景是3行）
    Set targetStart = ws.Range("B2") ' 纵向堆叠的起始位置
    currentCol = 2 ' 从B列（第2列）开始查找簇
    offsetRows = 0
    
    ' 循环检测所有有数据的横向簇
    Do While ws.Cells(2, currentCol).Value <> ""
        ' 定义当前要处理的区域簇
        Dim sourceCluster As Range
        Set sourceCluster = ws.Range(ws.Cells(2, currentCol), ws.Cells(2 + clusterRows - 1, currentCol + clusterCols - 1))
        ' 复制到目标位置
        sourceCluster.Copy Destination:=targetStart.Offset(offsetRows, 0)
        ' 更新偏移行数和下一个簇的起始列
        offsetRows = offsetRows + clusterRows
        currentCol = currentCol + clusterCols
    Loop
    
    ' 可选：如果需要清空原来的横向簇数据，取消下面这行的注释
    ' ws.Range(ws.Cells(2, 4), ws.Cells(clusterRows + 1, ws.UsedRange.Columns.Count)).ClearContents
End Sub

这个宏会自动从B列开始，每隔2列检测一个3行的簇，直到某一列第2行没有数据为止，自动完成所有簇的纵向堆叠。

备注：内容来源于stack exchange，提问作者DongM