Excel中JSON列转指定顺序新列的VBA宏问题求助

Sub ProcesarColumnaJSON()
    Dim columnaOriginal As Range
    Dim celda As Range
    Dim datosJSON As Dictionary ' JSON对象解析后返回Dictionary而非Collection
    Dim resultado As Variant
    Dim filaResultado As Long
    ' 定义需提取的字段顺序
    Dim campos As Variant
    campos = Array("id", "Codi_estacio", "Codi_variable", "Data_tectura", "Valor_lectura", "Codi_base")
    
    ' 定位A列的有效数据范围
    Set columnaOriginal = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    ' 写入字段标题到右侧首行
    Range("B1").Resize(1, UBound(campos) + 1).Value = campos
    filaResultado = 2 ' 数据从第2行开始
    
    ' 遍历每个JSON单元格
    For Each celda In columnaOriginal
        ' 跳过A1标题行（若A1是数据则删除此判断）
        If celda.Row = 1 Then GoTo NextCelda
        
        ' 解析JSON内容
        Set datosJSON = JsonConverter.ParseJson(celda.Value)
        
        ' 初始化结果数组（对应6个指定字段）
        ReDim resultado(1 To 1, 1 To UBound(campos) + 1)
        
        ' 按指定顺序提取字段，缺失则留空
        Dim i As Integer
        For i = LBound(campos) To UBound(campos)
            resultado(1, i + 1) = IIf(datosJSON.Exists(campos(i)), datosJSON(campos(i)), "")
        Next i
        
        ' 将结果写入当前行的右侧列
        Cells(filaResultado, 2).Resize(1, UBound(resultado, 2)).Value = resultado
        
        filaResultado = filaResultado + 1
NextCelda:
    Next celda
End Sub

• 类型修正：将datosJSON的类型从Collection改为Dictionary——单个JSON对象解析后返回的是Dictionary，原声明会导致类型不匹配错误。
• 固定列顺序：通过campos数组强制指定输出列的顺序，确保完全符合需求，不受JSON原键顺序影响。
• 容错处理：用Exists方法检查字段是否存在，缺失时填充空值，避免运行时报错。
• 标题行添加：自动在右侧列首行写入字段名，提升可读性。
• 范围优化：使用Resize精准定位写入区域，解决原代码中范围计算错误的问题。

1. 确保已正确设置JsonConverter：
   • 将JsonConverter.bas导入VBA项目
   • 在VBA编辑器的「工具」→「引用」中勾选「Microsoft Scripting Runtime」
2. 确认A列每个单元格的内容是有效的单个JSON对象（而非JSON数组）。

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