Question

Можно ли получить значение во вложенной коллекции, состоящей из нескольких вложенных коллекций и массивов, используя переменную?

Я выбираю данные через API в формате json, и для этого ясоздание парсера 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.

Tony Dallimore · Answer 1 · 19 июня 2019

Хотя я полагаю, что ответ, на который я ссылаюсь в своем комментарии, содержит некоторые идеи, которые могут вас заинтересовать, я не уверен, что ответ так же актуален, как я думал вначале.Этот OP может иметь дело с массивами неизвестного размера, но размер был известен на ранней стадии.Я предполагаю, что вы не знаете размер ваших коллекций и массивов вариантов и имеете возможность дополнительных элементов.

Я регулярно использую коллекции, в которые вкладываю другие коллекции и массивы.Но когда я прихожу читать данные, структура фиксируется и известна коду во время компиляции.Вы, конечно, не знаете длины коллекций и массивов и, возможно, не знаете, есть ли дополнительная часть.

Я решил, что было бы интересно посмотреть, смогу ли я искать во вложенных коллекциях и массивах так, как вы предполагаете.Мой код не такой аккуратный, как мог бы быть;Я столкнулся с проблемами, которых не ожидал, и перекодировал только по мере необходимости, чтобы преодолеть эти проблемы.Я понимаю, что ваш вопрос означает, что ваши тестовые данные являются лишь примером.Я не хотел тратить время на создание отшлифованного кода, если реальные данные, вероятно, будут значительно отличаться.

Ваши параметры имеют вид:

"(""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 s включаютвсе кавычки, потому что синтаксис 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 сначала разбивает координаты в массив.Итак, «(посетители) (человек) (0) (имя)» становится: Array (посетители, человек, 0, имя).Затем он копирует коллекцию jsonColl в локальную переменную NestedCrnt.После этой подготовки цикл выполняется для каждой координаты.

Цикл использует TypeName для идентификации NestedCrnt, поскольку обработка для коллекций и массивов различна.В любом случае он устанавливает 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 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Вложенная коллекция VBA - динамически получать значения по «вложенным» ключам / индексу, используя переменную

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов