如何用VBA循环将GDP数据按单元格拆分3次并依次排列？

我来帮你搞定这个问题！你的代码核心问题是写入位置没有动态跟踪——每次处理新的季度GDP单元格时，都从E13开始偏移写入，后面的季度数据直接覆盖了前面的结果，所以最终只保留了第一个季度拆分的3个值。

修正后的代码 #

Sub PIB()
    Dim lista As Range
    Dim cell As Range
    Dim writeRow As Long ' 用于跟踪写入的目标行号
    
    Set lista = Range("D13:D275")
    writeRow = 13 ' 起始写入行，对应E列的第13行
    
    ' 先清空目标列（可选，避免残留旧数据）
    Range("E13:E" & lista.Rows.Count * 3 + 12).ClearContents
    
    For Each cell In lista
        ' 每个季度拆分为3个月，依次写入E列
        For i = 1 To 3
            Range("E" & writeRow).Value = cell.Value / 3
            writeRow = writeRow + 1 ' 写完一行后，行号+1，准备写下一个值
        Next i
    Next cell
End Sub

关键修改点说明 #

• 新增writeRow变量：用来记录当前要写入的E列行号，初始值设为你指定的起始行13，每写入一个月度值就自动加1，确保后续数据依次往下排，不会覆盖之前的内容。
• 可选的清空操作：在开始写入前清空目标列的对应范围，避免之前的旧数据干扰结果（范围计算逻辑是：季度数据行数×3 + 起始行前一行，确保覆盖所有要写入的行）。
• 写入位置改为Range("E" & writeRow)：直接通过行号定位，替代原来固定从E13偏移的写法，实现动态跟进。

额外灵活版提示 #

如果你的起始行或者数据范围可能变化，可以把代码改成更适配的版本，自动获取起始行：

Sub PIB_Flexible()
    Dim lista As Range
    Dim cell As Range
    Dim writeRow As Long
    Dim startRow As Long
    
    Set lista = Range("D13:D275")
    startRow = lista.Cells(1, 1).Row ' 获取D列数据的起始行
    writeRow = startRow ' E列起始行和D列一致
    
    Range("E" & startRow & ":E" & startRow + lista.Rows.Count * 3 - 1).ClearContents
    
    For Each cell In lista
        For i = 1 To 3
            Range("E" & writeRow).Value = cell.Value / 3
            writeRow = writeRow + 1
        Next i
    Next cell
End Sub

内容的提问来源于stack exchange，提问作者Jaffet León