时间戳

首页 > 解决方案 > 递归地将信息添加到单元格 VBA Excel

excel - 递归地将信息添加到单元格 VBA Excel

问题描述

我正在递归地循环一个对象。每个节点有 3 个值。我想让每一行代表单个节点中的信息。我基本上想将数据放入下表中顺序的工作表中。由于递归，我无法跟踪变量。

一种 乙 C
1 2 3
4 5 6
7 8 9
10 11 12
13 14 15

我收到 JSON 作为对查询的响应。

Option Explicit
Dim controlS As Object
Sub p()
Dim key, Keys As Object, JSON As String
JSON = "{""requestId"": ""111111"",""nextTime"": null,""returned"": 6,""scanned"": 12345,""result"": ""[{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Defect\"",\""value\"":403},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Out\"",\""value\"":3},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Load\"",\""value\"":6414},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""ZKC\"",\""value\"":959},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Ops\"",\""value\"":1697},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""SCEX\"",\""value\"":14241}]"",""continuationToken"": null}"
Set controlS = CreateObject("ScriptControl")
controlS.Language = "JScript"

controlS.Eval ("var J = " & JSON)
controlS.Eval ("var R = eval(J.result)")
controlS.AddCode "function k(a){var k=[];for(var b in a){k.push('[\'' + b + '\']');}return k;}"
controlS.AddCode "function t(a){return{}.toString.call(a).slice(8,-1)}"
Set Keys = controlS.Eval("k(R)")
For Each key In Keys
    Call JSONLoop(key)
Next key
End Sub
Private Sub JSONLoop(ByVal key As Variant)
If Not controlS.Eval("t(R" & key & ")") = "Object" And Not controlS.Eval("t(R" & key & ")") = "Array" Then
    Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1) = controlS.Eval("R" & key) ' This part is the problem
Else
    If Not IsNull(controlS.Eval("R" & key)) = True Then
        Dim key2
        For Each key2 In controlS.Eval("k(R" & key & ")")
        Call JSONLoop(key & key2)
        Next key2
    End If
End If
End Sub

标签： excelvba

解决方案

添加 ByRef 参数以跟踪递归。

Sub p()
    Dim key, Keys As Object, JSON As String
    JSON = "{""requestId"": ""111111"",""nextTime"": null,""returned"": 6,""scanned"": 12345,""result"": ""[{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Defect\"",\""value\"":403},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Out\"",\""value\"":3},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Load\"",\""value\"":6414},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""ZKC\"",\""value\"":959},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""Ops\"",\""value\"":1697},{\""timeS\"":\""2020-02-10\"",\""metric\"":\""SCEX\"",\""value\"":14241}]"",""continuationToken"": null}"
   
    Set controlS = CreateObject("ScriptControl")
    controlS.Language = "JScript"
    
    controlS.Eval ("var J = " & JSON)
    controlS.Eval ("var R = eval(J.result)")
    controlS.AddCode "function k(a){var k=[];for(var b in a){k.push('[\'' + b + '\']');}return k;}"
    controlS.AddCode "function t(a){return{}.toString.call(a).slice(8,-1)}"
    Set Keys = controlS.Eval("k(R)")
    For Each key In Keys
        Call JSONLoop(key, 0)
    Next key
    MsgBox "Done"
End Sub

Private Sub JSONLoop(ByVal key As Variant, ByRef c As Integer)
   
    If Not controlS.Eval("t(R" & key & ")") = "Object" And Not controlS.Eval("t(R" & key & ")") = "Array" Then
        Sheet1.Cells(Rows.Count, c).End(xlUp).Offset(1) = controlS.Eval("R" & key) ' This part is the problem
    Else
        If Not IsNull(controlS.Eval("R" & key)) = True Then
            Dim key2
            For Each key2 In controlS.Eval("k(R" & key & ")")
                c = c + 1
                Call JSONLoop(key & key2, c)
            Next key2
        End If
    End If
End Sub

推荐阅读