VBA解析股票嵌套JSON 提取指定到期日CE/PE期权数据导入Excel

前置准备 #

• 先下载导入VBA-JSON解析模块，将对应的.bas文件导入你的VBA工程即可完成JSON解析能力配置
• 进入VBA编辑器，点击「工具-引用」，勾选Microsoft Scripting Runtime，避免字典对象调用时报错

调整后的完整代码 #

Sub 导出指定到期日期权数据到Excel()
    Dim jsonStr As String, json As Object
    Dim targetExpiry As String, expiryItem As Object
    Dim strikeItem As Object, ceData As Object, peData As Object
    Dim ws As Worksheet
    Dim rowNum As Long, colNum As Long
    Dim ceKeys As Variant, peKeys As Variant, i As Integer
    
    ' 替换为你实际请求接口拿到的完整JSON响应字符串
    jsonStr = "你的接口返回JSON字符串"
    targetExpiry = "30-Sep-2021"
    
    ' 初始化存储数据的工作表
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = targetExpiry & "期权数据"
    rowNum = 1
    
    ' 解析JSON字符串
    Set json = JsonConverter.ParseJson(jsonStr)
    
    ' 遍历到期日数组，定位目标到期日节点，可根据你的实际JSON结构调整访问路径
    For Each expiryItem In json("data")("expiries")
        If expiryItem("expiryDate") = targetExpiry Then
            ' 提取CE、PE的所有字段名生成表头
            Set strikeItem = expiryItem("strikes")(1)
            ceKeys = strikeItem("CE").Keys
            peKeys = strikeItem("PE").Keys
            
            ' 写入表头：行权价+CE字段+PE字段，加前缀避免CE、PE同名字段冲突
            ws.Cells(rowNum, 1) = "行权价"
            colNum = 2
            For i = LBound(ceKeys) To UBound(ceKeys)
                ws.Cells(rowNum, colNum) = "CE_" & ceKeys(i)
                colNum = colNum + 1
            Next i
            For i = LBound(peKeys) To UBound(peKeys)
                ws.Cells(rowNum, colNum) = "PE_" & peKeys(i)
                colNum = colNum + 1
            Next i
            rowNum = rowNum + 1
            
            ' 遍历所有行权价写入对应数据
            For Each strikeItem In expiryItem("strikes")
                ws.Cells(rowNum, 1) = strikeItem("strikePrice")
                colNum = 2
                
                ' 写入CE字段，处理部分行权价无CE挂单的空值情况
                If strikeItem.Exists("CE") Then
                    Set ceData = strikeItem("CE")
                    For i = LBound(ceKeys) To UBound(ceKeys)
                        ws.Cells(rowNum, colNum) = ceData(ceKeys(i))
                        colNum = colNum + 1
                    Next i
                Else
                    colNum = colNum + UBound(ceKeys) - LBound(ceKeys) + 1
                End If
                
                ' 写入PE字段，处理部分行权价无PE挂单的空值情况
                If strikeItem.Exists("PE") Then
                    Set peData = strikeItem("PE")
                    For i = LBound(peKeys) To UBound(peKeys)
                        ws.Cells(rowNum, colNum) = peData(peKeys(i))
                        colNum = colNum + 1
                    Next i
                End If
                
                rowNum = rowNum + 1
            Next strikeItem
            
            ' 自动调整列宽优化展示
            ws.Columns.AutoFit
            MsgBox "导出完成，共导出" & rowNum - 2 & "条行权价记录"
            Exit Sub
        End If
    Next expiryItem
    
    MsgBox "未找到到期日为" & targetExpiry & "的期权数据"
End Sub

自定义适配说明 #

• 如果你的JSON存储到期日的数组路径和代码中假设的json("data")("expiries")不一致，直接修改该访问路径即可，比如数组存在根节点records下就改为json("records")
• 如果接口返回的到期日不是字符串格式而是时间戳格式，提前把targetExpiry转换为对应时间戳再做等值判断即可

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