VBA逐行逐值写入列成功 第三列无法填充全范围问题求助

核心问题点 #

• 变量定义与使用不匹配：代码声明段定义了ids对象，后续赋值时却使用未在Dim段声明的ID，不规范的变量引用容易引发对象异常。
• 第三列取值逻辑错误：你定义的sets范围是A24:G24，仅1行7列，与原数据源的7列一一对应，但代码中写的sets(rw, col)会随着遍历行号rw增长到2以上就触发下标越界，直接中断代码运行，导致无法完成全范围数据填充。实际上sets的取值只和当前遍历的列号col有关，行索引固定为1即可。
• 冗余清空操作：代码中rng.ClearContents会清空原A1:G23的数据源，如果你需要保留原表数据，可删除或注释该行。

修复后完整代码 #

Sub OneColumnData()
    Dim rng As Range, ids As Range, sets As Range, arr() As Variant, rw As Long, col As Long, counter As Long

    Set rng = Range("A1:G23")
    Set ids = Range("H1:H23")
    Set sets = Range("A24:G24")

    arr = rng.Value
    counter = 1

    ' 需保留原A1:G23数据请注释掉下一行
    rng.ClearContents

    For rw = 1 To UBound(arr, 1)
        For col = 1 To UBound(arr, 2)
            If arr(rw, col) <> vbNullString Then
                Range("O" & counter) = arr(rw, col)
                Range("P" & counter) = ids(rw)
                ' 取当前列对应的第24行匹配值，sets仅1行，行索引固定为1
                Range("Q" & counter) = sets(1, col)
                counter = counter + 1
            End If
        Next col
    Next rw
End Sub

修复后逻辑说明 #

代码会逐行逐列遍历A1:G23的所有单元格，遇到非空值时按顺序写入O列，对应行的H列ID写入P列，该单元格所在列对应的A24:G24配置值写入Q列，最终完成全范围有效数据的逐行向下填充。

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