VBA中如何使用ReDim Preserve处理数组以避免运行时错误9（下标越界）？

错误原因分析 #

你的问题核心出在对数组维度的误解上：
当你用Application.Transpose(Range(Cells(4, 1), Cells(4, g)))转置单行区域时，得到的并不是一维数组，而是二维数组（结构为(1 to 行数, 1 to 1)）。所以循环里用laArray(f)直接访问时，就会触发「下标越界」错误——因为二维数组必须传入行、列两个索引才能取值。

另外，你代码里先把区域赋值给laArray，紧接着又用转置后的区域覆盖它，这一行完全多余，可以直接删除：

laArray = (Range(Cells(4, 1), Cells(4, g)).Value2)  ' 此行无意义，直接删除

快速修复方案（无需ReDim） #

只需要修改循环内的数组访问方式，加上第二个下标1，同时简化数组赋值步骤：

JSON = Cells(1, 1)
lcReplace = Array("}", "{", "/", "\", """", ":", ";", "items", "[", "]", "_")
For Each A In lcReplace
    JSON = Replace(JSON, A, " ")
Next A
Cells(2, 1) = JSON

' 保留文本分列逻辑
Cells(2, 1).TextToColumns Destination:=Range("A4"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False

g = Cells(4, 1).End(xlToRight).Column
Dim laArray As Variant
' 直接转置单行区域，得到二维数组(1 to g, 1 to 1)
laArray = Application.Transpose(Range(Cells(4, 1), Cells(4, g)))

' 循环时使用二维数组的完整索引
For f = LBound(laArray) To UBound(laArray)
    Cells(f + 4, 3) = laArray(f, 1)  ' 补充第二个下标1
Next f

更高效的替代方案（避免文本分列） #

你提到最初想通过字符串操作替代文本分列，其实直接解析JSON是更可靠、高效的方案（文本分列容易因格式细节出错）。推荐使用VBA-JSON库（可直接导入VBA项目），它能直接将JSON字符串解析为对象，跳过繁琐的替换和分列步骤。

示例思路：

1. 导入VBA-JSON库（VBA编辑器→工具→引用→浏览选中库文件，或直接复制模块代码）
2. 解析JSON字符串，提取目标数据
3. 直接将数据写入单元格，无需数组转置

简化代码示例：

Dim jsonObj As Object
Set jsonObj = JsonConverter.ParseJson(Cells(1, 1).Value)

' 假设JSON包含items数组，根据实际结构调整字段名
Dim item As Variant
Dim rowNum As Integer
rowNum = 4
For Each item In jsonObj("items")
    Cells(rowNum, 3).Value = item("目标字段1")
    Cells(rowNum, 4).Value = item("目标字段2")
    rowNum = rowNum + 1
Next item

这种方法彻底避免了数组维度问题，运行速度更快，也更适配JSON数据的原生结构。

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