Question

是否可以使用变量在由多个嵌套集合和数组组成的嵌套集合中检索值？

我正在通过json格式的API来获取数据，为此，我正在创建一个json解析器（我知道在线上有一些可用的文件，但是出于我的实际和兴趣，我创建了自己的）。

下面是一个测试设置，我在其中创建了一个样本集合，该样本集合由多个级别的集合和数组组成。

    Dim tempColl as new collection, jsonColl as new collection, _
    tempStr as string, tempArr as variant 

    '' "temp" meaning "temporary"

    tempColl.Add "Christian", "name"
    tempColl.Add "en-us", "language"

    tempArr = Array(tempColl)

    Set tempColl = New Collection

    tempColl.Add tempArr, "person"

    jsonColl.Add tempColl, "visitors"

    '' Attempt to fetch value by using list of keys in a variable
    '' None of them is working though.

    tempStr = "(""person"")(0)(""name"")"
    Debug.Print jsonColl("visitors") & tempStr

    tempStr = "(""visitors"")(""person"")(0)(""name"")"
    Debug.Print jsonColl.tempStr

在“本地”窗口中查看集合将提供以下信息：

问题：

是否可以使用上面的变量来自然地使用另一种方法访问这些值，还是我必须写出我希望手动获取的所有值？

请注意，使用字典不是一种选择，因为它也必须在Mac上也可以使用。

Answer 1

尽管我相信我在评论中引用的答案包含一些您可能会发现有趣的想法，但我不确定该答案是否像我最初想的那样相关。该OP可能正在处理大小未知的数组，但是大小在早期就已知道。我假设您不知道Collections和Variant Array的大小，并且有可能使用可选元素。

我经常使用在其中嵌套其他集合和数组的集合。但是，当我开始读取数据时，结构是固定的，并且在编译时为代码所知。您当然不知道Collections和Arrays的长度，也可能不知道是否存在可选部分。

我决定看看是否可以按照您设想的方式搜索嵌套的Collections和Arrays会很有趣。我的代码不那么整洁；我遇到了我没想到的问题，仅根据需要重新编码以克服这些问题。我将您的问题解释为意味着您的测试数据仅是示例。如果实际数据可能有很大不同，我不想花时间来创建完善的代码。

您的参数的格式为：

"(""visitors"")(""person"")(0)(""name"")"

我认为所有这些引号都是痛苦的，而痛苦的是，所以我改为：

"(visitors)(person)(0)(name)"

如果这些引号由于某些原因是必不可少的，则可以修改我的代码以包含它们。

我的代码通过构建示例结构来开始您的发言。

然后是一串长长的Debug.Print语句，例如：

Debug.Print "TypeName(jsonColl) " & TypeName(jsonColl)
Debug.Print "Value jsonColl(""visitors"")(""person"")(0)(""language"") " & _
          jsonColl("visitors")("person")(0)("language")

请注意，这些Debug.Print包含所有引号，因为VBA语法要求使用引号。是我的宏不使用它们。如果您不熟悉访问结构所需的语法，那么您可能会发现这些Debug.Print’s有帮助。我用它们来提醒自己语法，并确保我对您的结构有完整的了解。

然后我有：

For Each Coords In Array("(visitors)(person)(0)(name)", _
                         "(visitors)(person)(0)(language)", _
                         "visitors)(person)(0)(language)", _
                         "(visitors)(person)(0)(language", _
                         "(visitors)(person)(1)(language)", _
                         "(visitors)(person)(0)(age)", _
                         "(visitors)(person)(0)(name)(1)")
  Call GetValueFromNested(jsonColl, CStr(Coords), Value, ErrMsg)

不考虑所有复杂性，每个循环调用GetValueFromNested以获得一组坐标。前两组提取示例人的姓名和语言。其他所有集合都是错误的，因此我可以检查错误处理。

对于一组坐标，GetValueFromNested返回一个值或将ErrMsg设置为一条错误消息，说明为什么它无法返回值。

GetValueFromNested首先将坐标拆分为一个数组。因此，“（visitors）（person）（0）（name）”变为：Array（visitors，person，0，name）。然后，它将集合jsonColl复制到本地变量NestedCrnt。准备之后，它会为每个坐标循环。

循环使用TypeName来标识NestedCrnt，因为对Collections和Arrays的处理是不同的。无论哪种方式，它都将NestedCrnt设置为NestedCrnt(Coord)。因此，使用“（访客）（人）（0）（姓名）”：

Initial value of `NestedCrnt` is `jsonColl `
Loop 1 changes `NestedCrnt` to the value of `jsonColl(visitor)`.
Loop 2 changes `NestedCrnt` to the value of `jsonColl(visitor)(person)`.
Loop 3 changes `NestedCrnt` to the value of `jsonColl(visitor)(person)(0)`.
Loop 4 changes `NestedCrnt` to the value of `jsonColl(visitor)(person)(0)(name)`.

NestedCrnt的最终值“基督徒”将通过“值”返回给调用方。

所有并发症都在宏中进行了解释。

我确信您会在我的代码中发现缺陷，因为我仅使用示例结构对其进行了测试。我也确定您将需要一个名为GetBoundsOfNested之类的宏。因此GetBoundsOfNested(jsonColl, "(visitor)(person)")会告诉您您有多少人，这样您就可以从下限到上限循环获取他们的名字。

Option Explicit
Sub TestJsonCollArr()

  Dim tempColl As New Collection, jsonColl As New Collection, _
      TempStr As String, tempArr As Variant
  Dim Coords As Variant
  Dim ErrMsg As String
  Dim Value As Variant

  tempColl.Add "Christian", "name"
  tempColl.Add "en-us", "language"

  tempArr = Array(tempColl)

  Set tempColl = New Collection

  tempColl.Add tempArr, "person"

  jsonColl.Add tempColl, "visitors"

  ' Output informaton about jsonColl and its elements to help understand
  ' requirement.
  Debug.Print "TypeName(jsonColl) " & TypeName(jsonColl)
  Debug.Print "jsonColl.Count " & jsonColl.Count
  Debug.Print "TypeName(jsonColl(1)) " & TypeName(jsonColl(1))
  Debug.Print "TypeName(jsonColl(""visitors"")) " & TypeName(jsonColl("visitors"))
  Debug.Print "CollKeyExists(jsonColl, ""visitors"") " & CollKeyExists(jsonColl, "visitors")
  Debug.Print "jsonColl(""visitors"").Count " & jsonColl("visitors").Count
  Debug.Print "TypeName(jsonColl(""visitors""(1))) " & TypeName(jsonColl("visitors")(1))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person""))) " & _
              TypeName(jsonColl("visitors")("person"))
  Debug.Print "Bounds jsonColl(""visitors""(1)) " & LBound(jsonColl("visitors")(1)) & _
              " to " & UBound(jsonColl("visitors")(1))
  Debug.Print "Bounds jsonColl(""visitors""(""person"")) " & _
              LBound(jsonColl("visitors")("person")) & _
              " to " & UBound(jsonColl("visitors")("person"))
  Debug.Print "TypeName(jsonColl(""visitors"")(1)(0)) " & TypeName(jsonColl("visitors")(1)(0))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)) " & _
              TypeName(jsonColl("visitors")("person")(0))
  Debug.Print "jsonColl(""visitors"")(1)(0).Count " & jsonColl("visitors")(1)(0).Count
  Debug.Print "jsonColl(""visitors"")(""person"")(0).Count " & _
              jsonColl("visitors")("person")(0).Count
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)(1)) " & _
              TypeName(jsonColl("visitors")("person")(0)(1))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)(""name"")) " & _
              TypeName(jsonColl("visitors")("person")(0)("name"))
  Debug.Print "TypeName(jsonColl(""visitors"")(""person"")(0)(""language"")) " & _
              TypeName(jsonColl("visitors")("person")(0)("language"))
  Debug.Print "Value jsonColl(""visitors"")(""person"")(0)(""name"") " & _
              jsonColl("visitors")("person")(0)("name")
  Debug.Print "Value jsonColl(""visitors"")(""person"")(0)(""language"") " & _
              jsonColl("visitors")("person")(0)("language")

  For Each Coords In Array("(visitors)(person)(0)(name)", _
                           "(visitors)(person)(0)(language)", _
                           "visitors)(person)(0)(language)", _
                           "(visitors)(person)(0)(language", _
                           "(visitors)(person)(1)(language)", _
                           "(visitors)(person)(0)(age)", _
                           "(visitors)(person)(0)(name)(1)")
    ' Note: GetValueFromNested requires the second parameter be a string but
    '       For Each requires Coords to be a Variant.  CStr converts the
    '       variant Coords to the required string.
    Call GetValueFromNested(jsonColl, CStr(Coords), Value, ErrMsg)
    Debug.Print "Coords " & Coords
    Debug.Print "Value " & Value
    Debug.Print "ErrMsg " & ErrMsg
    Debug.Print "------"
  Next

End Sub
Function GetNextElement(ByRef NestedNext As Variant, _
                        ByRef NestedElement As Variant) As Boolean

  ' Copy the value of NestedElement to NestedNext

  ' * In the call of GetNextElement, NestedElement will be an expression of the
  '   form: NestedCrnt(Index).
  ' * If both NestedCrnt and NestedElement are Collections,
  '   "Set NestedCrnt = NestedElement" will correctly copy the value of
  '   NestedElement to NestedCrnt
  ' * If NestedCrnt is a Collection and NestedElement is a Variant array, the
  '   assignment fails.  No error is given but NestedCrnt is unchanged.
  ' * This routine was coded to explore what works and what does not.
  ' * It appears the initial value of NestedCrnt does not matter.  If
  '   NestedElement is a Collection, the assignment must start with "Set".
  '   If NestedElement is a Variant Array, the "Set" must be omitted.

  Dim ErrNum As Long
  Dim NestedLocal As Variant
  Dim TypeNameExptd As String
  Dim TypeNameGot As String
  Dim TypeNameOrig As String

  TypeNameOrig = TypeName(NestedNext)
  TypeNameExptd = TypeName(NestedElement)

  'Debug.Print NestedNext("visitors")("person")(0)("language")
  'Debug.Print NestedElement("person")(0)("language")
  'Debug.Print NestedNext("person")(0)("language")
  'Debug.Print NestedElement(0)("language")
  'Debug.Print NestedNext("language")
  'Debug.Print NestedElement

  ' First get element out of NestedElement into local variable without
  ' changing NestedNext which is probably the parent of NestedElement
  On Error Resume Next
  If TypeNameOrig = "Collection" And TypeNameExptd = "Collection" Then
    Set NestedLocal = NestedElement
  ElseIf TypeNameOrig = "Variant()" And TypeNameExptd = "Variant()" Then
    NestedLocal = NestedElement
  ElseIf TypeNameOrig = "Collection" And TypeNameExptd = "Variant()" Then
    NestedLocal = NestedElement
  Else
    NestedLocal = NestedElement
  End If
  ErrNum = Err.Number
  On Error GoTo 0

  If ErrNum <> 0 Then
    GetNextElement = False
    Exit Function
  End If

  ' Now copy value from local variable to NestedNext
  On Error Resume Next
  If TypeNameOrig = "Collection" And TypeNameExptd = "Collection" Then
    Set NestedNext = NestedLocal
  ElseIf TypeNameOrig = "Variant()" And TypeNameExptd = "Variant()" Then
    NestedNext = NestedLocal
  ElseIf TypeNameOrig = "Collection" And TypeNameExptd = "Variant()" Then
    NestedNext = NestedLocal
  Else
    NestedNext = NestedLocal
  End If
  ErrNum = Err.Number
  On Error GoTo 0

  If ErrNum <> 0 Then
    GetNextElement = False
    Exit Function
  End If

  TypeNameGot = TypeName(NestedNext)

  If TypeNameExptd <> TypeNameGot Then
    GetNextElement = False
    Debug.Assert False     ' Investigate error
    Exit Function
  End If

  'Debug.Print NestedLocal("person")(0)("language")
  'Debug.Print NestedNext("person")(0)("language")
  'Debug.Print NestedLocal(0)("language")
  'Debug.Print NestedNext(0)("language")
  'Debug.Print NestedLocal
  'Debug.Print NestedNext

  GetNextElement = True

End Function
Sub GetValueFromNested(ByRef Nested As Variant, ByVal Coords As String, _
                       ByRef Value As Variant, ByRef ErrMsg As String)

  ' * If possible, set Value to the element of Nested defined by Coord
  '   and set ErrMsg = "".
  ' * If not possible, set ErrMsg to the reason it is not possible.

  ' * Nested can be a Collection, a Variant array or a regular array. "Regular"
  '   means String, Long or any other standard data type other than Variant.
  '   Elements of a Collection or a Variant array can be Collections, Variant
  '   arrays, regular array, or single values of any standard data type.
  ' * Coords is a string of the form: (Z)(Y)(X)(W)...
  '   Z identifies an element within Nested.
  '   Y identifies an element within Nested(Z).
  '   X identifies an element within Nested(Z)(Y).
  '   Coords may contain as many of Z, Y, X and so on as necessary to
  '   identify an inner element of Nested.
  '   If Z, Y, X and so on identify the element of a Collection, they may be
  '   integer position within the Collection of the key of an element.  If they
  '   identify the element of an array, they must be an integer position
  '   The inner element identified by Coord must be a single value.
  ' * Value will be set to the single value identified by Coord if Coord does
  '   identify a single value.
  ' * ErrMsg will be set to an appropriate error message if Coord does not
  '   identify a single value.  Note: ErrMsg is not intended to be intelligible to
  '   a user; it is intended to aid the developer diagnose errors in their code.

  Dim CoordParts() As String
  Dim ElmntId As String
  Dim ErrNum As Long
  Dim InxCP As Long
  Dim InxNP As Long
  Dim NestedCrnt As Variant
  Dim StrTemp As String
  Dim TypeNameCrnt As String

  Value = ""
  ErrMsg = ""
  ElmntId = "Nested"

  ' Split Coords into its components
  If Left$(Coords, 1) <> "(" Or Right$(Coords, 1) <> ")" Then
    ErrMsg = "Coords must start with a ( and end with a )"
    Exit Sub
  End If
  ' Any futher errors in Coords will be identified by the failure to
  ' find an element or sub-element of Nested.
  Coords = Mid$(Coords, 2, Len(Coords) - 2) ' Strip off leading and trailing paratheses
  CoordParts = Split(Coords, ")(")

  Set NestedCrnt = Nested

  For InxCP = LBound(CoordParts) To UBound(CoordParts)
    TypeNameCrnt = TypeName(NestedCrnt)
    Select Case TypeNameCrnt
      Case "Collection"
        ' CoordParts(InxCP) can be a key or an integer position
        If IsNumeric(CoordParts(InxCP)) And _
           InStr(1, CoordParts(InxCP), ".") = 0 Then
          ' CoordParts(InxCP) is an integer position
          If Not GetNextElement(NestedCrnt, NestedCrnt(CLng(CoordParts(InxCP)))) Then
            ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                     ". Valid indices are in the range 1 to " & NestedCrnt.Count
            Exit Sub
          End If
        Else
          ' CoordParts(InxCP) is a key or invalid
          On Error Resume Next
          StrTemp = TypeName(NestedCrnt(CoordParts(InxCP)))
          ErrNum = Err.Number
          On Error GoTo 0
          If ErrNum = 0 Then
            If Not GetNextElement(NestedCrnt, NestedCrnt(CoordParts(InxCP))) Then
              ErrMsg = "No element of " & ElmntId & " has a key of """ & _
                       CoordParts(InxCP) & """"
              Exit Sub
            End If
          Else
            ErrMsg = "No element of " & ElmntId & " has a key of """ & _
                     CoordParts(InxCP) & """"
            Exit Sub
          End If
        End If
      Case "Variant()"
        ' CoordParts(InxCP) can only be an integer position
        If IsNumeric(CoordParts(InxCP)) And _
           InStr(1, CoordParts(InxCP), ".") = 0 Then
          ' CoordParts(InxCP) is an integer position
          If CoordParts(InxCP) >= LBound(NestedCrnt) And _
             CoordParts(InxCP) <= UBound(NestedCrnt) Then
            Set NestedCrnt = NestedCrnt(CLng(CoordParts(InxCP)))
          Else
            ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                     ". Valid indices are in the range " & _
                     LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
            Exit Sub
          End If
        Else
          ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                   ". Valid indices are integers in the range " & _
                   LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
          Exit Sub
        End If
      Case Else
        ' Only valid values are of the form "Xxxxx()" where "Xxxxx" is a
        ' standard data type.  Should perhaps validate "Xxxxx" but have not.
        If Right$(TypeNameCrnt, 2) = "()" Then
          ' Have an array. CoordParts(InxCP) can only be an integer position
          If IsNumeric(CoordParts(InxCP)) And _
             InStr(1, CoordParts(InxCP), ".") = 0 Then
            ' CoordParts(InxCP) is an integer position
            If CoordParts(InxCP) >= LBound(NestedCrnt) And _
               CoordParts(InxCP) <= UBound(NestedCrnt) Then
              Set NestedCrnt = NestedCrnt(CLng(CoordParts(InxCP)))
            Else
              ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                       ". Valid indices are in the range " & _
                       LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
              Exit Sub
            End If
          Else
            ErrMsg = CoordParts(InxCP) & " is not an element of " & ElmntId & _
                     ". Valid indices are integers in the range " & _
                     LBound(NestedCrnt) & " to " & UBound(NestedCrnt)
            Exit Sub
          End If
        Else
          ErrMsg = "There is no element " & CoordParts(InxCP) & " of " & _
                   ElmntId & vbLf & " because " & ElmntId & _
                   " is not a Collection or an Array"
          Exit Sub
        End If

    End Select

    ElmntId = ElmntId & "(" & CoordParts(InxCP) & ")"

  Next

  If NestedCrnt = "" Then
    ' An empty string is a permitted value
    Value = ""
  Else
    TypeNameCrnt = TypeName(NestedCrnt)
    If TypeNameCrnt = "Collection" Then
      ErrMsg = ElmntId & " is a Collection when it should be a single value"
    ElseIf Right$(TypeNameCrnt, 2) = "()" Then
      ErrMsg = ElmntId & " is an Array when it should be a single value"
    Else
      Value = NestedCrnt
    End If
  End If

End Sub
Function CollKeyExists(Coll As Collection, Key As String) As Boolean

  Dim ErrNum As Long
  Dim TempStr As String

  On Error Resume Next
  TempStr = TypeName(Coll(Key))
  ErrNum = Err.Number
  On Error GoTo 0
  If ErrNum = 0 Then
    CollKeyExists = True
  Else
    CollKeyExists = False
  End If

End Function

VBA嵌套集合-使用变量通过“嵌套”键/索引动态获取值

1 个答案: