如何使用Excel VBA将分散在多行的同条记录数据合并到单行？

我有一个约20000行的Excel文件，每条记录的数据按固定规则分布在连续4行中。我希望将这些数据整合到同一行展示：即新增若干空白列，把每条记录中除首行外的其他行数据移动到该记录的首行对应列中，随后删除每条记录的第2、3、4行空行。

源文件示例：

预期效果：

方法1：Power Query法（推荐，无代码基础也可操作，处理2万行效率极高） #

• 操作步骤：
  1. 选中数据源任意单元格，点击菜单栏「数据」选项卡 → 「从表格/区域」，将数据导入Power Query编辑器
  2. 新增索引列：点击「添加列」→ 「索引列」→ 「从1开始」
  3. 生成分组标识：新增自定义列，公式输入Number.RoundDown(([索引]-1)/4)，确认后得到每4行记录对应的统一分组ID
  4. 分组聚合：点击「转换」→ 「分组依据」，分组选择刚才生成的自定义列，操作类型选「所有行」
  5. 展开数据：点击新增的聚合列右上角的扩展按钮，选择需要提取的所有列，取消勾选「使用原始列名作为前缀」，确认后即可得到4行数据横向展开的效果
  6. 删除多余的索引、分组ID列，点击「关闭并上载」导出到Excel即可，2万行数据处理耗时通常不超过10秒。

方法2：函数公式法（适合小数据量临时使用） #

• 假设源数据保存在Sheet1，从A1单元格开始排布：
  1. 新建空白工作表，A1单元格输入公式=OFFSET(Sheet1!$A$1,ROW(A1)*4-4+INT((COLUMN(A1)-1)/[原单行列数]),MOD(COLUMN(A1)-1,[原单行列数]))
  2. 把公式里的[原单行列数]替换成你原始数据每行的列数，公式向右拉到覆盖4行总列数，再向下拉直到出现空白值
  3. 选中所有生成的结果，右键选择「粘贴为值」，删除末尾空白行即可。
     注意：如果不需要保留原文件数据，也可以直接在原表空白区域输入公式，操作完成后覆盖原数据即可。

方法3：VBA宏法（适合需要重复批量处理同类型文件的场景） #

• 按下Alt+F11打开VBA编辑器，右键当前工作簿 → 「插入」→ 「模块」，粘贴以下代码：

Sub 四行记录合并为一行()
    Dim i As Long, lastRow As Long, targetRow As Long, colCount As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    targetRow = 1
    ' 原始数据单行的列数，可自行修改
    colCount = 3
    Application.ScreenUpdating = False
    For i = 1 To lastRow Step 4
        Range(Cells(i, 1), Cells(i, colCount)).Copy Cells(targetRow, 1)
        Range(Cells(i + 1, 1), Cells(i + 1, colCount)).Copy Cells(targetRow, colCount + 1)
        Range(Cells(i + 2, 1), Cells(i + 2, colCount)).Copy Cells(targetRow, colCount * 2 + 1)
        Range(Cells(i + 3, 1), Cells(i + 3, colCount)).Copy Cells(targetRow, colCount * 3 + 1)
        targetRow = targetRow + 1
    Next i
    ' 删除多余行
    Rows(targetRow & ":" & lastRow).Delete
    Application.ScreenUpdating = True
End Sub

• 修改代码里的colCount参数为你原始数据每行的列数，按下F5运行即可，操作前建议提前备份原文件避免数据丢失。

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