vba - 在vba中UnNest无限数量的嵌套对象

Question

我想通过 ParamArray 获取任意数量的对象，然后将它们或嵌套在其中的变量添加到集合中。棘手的部分是，如果该嵌套对象是某种容器(集合、脚本字典甚至是具有计数方法的自定义类)也有嵌套在其中的变量，我希望它返回集合中的变量，而不是容器.

它会是这样的，让我们从创建一个用例开始:

Sub MakeItems()
Dim ReturnedColl as Collection
Dim aString as String
Dim TopColl as New Collection, NestedColl as New Collection, SubNestedDic as New Dictionary
Dim aRangeofManyCells as Range, aRangeofOneCell as Range
Dim anObject as newObject,  NestedObject as New Object, SubNestedObject as New Object

 aString = "Just a string"

 Set aRangeofManyCells = Range("A1:C3")
 Set aRangeofOneCell = Range("A4")

 SubNestedDic.Add SubNestedObject
 SubNestedDic.Add aRangeofOneCell

 NestedColl.Add SubNestedDic
 NestedColl.Add NestedObject
 NestedColl.Add SubNestedDic
 NestedColl.Add aRangeofManyCells

 TopColl.Add aString
 TopColl.AddNestedColl

 Set ReturnedColl = UnNest(TopColl, TopColl, anObject, Range("Sheet1:Sheet3!Q1"))

 For each Item in ReturnedColl
 'do something
 Next Item
End Sub

这是我无法弄清楚的部分。
我想做一个像这样的循环，使项目成为新项目，然后查看项目中的每个项目(如果有的话)，但不会丢失原始项目的跟踪，因为我必须去下一个元素。

Function UnNest(ParamArray Items() as Variant) as Collection
 For Each Item in Items
     If Item 'is a container of some sort' Then
        'some kind of loop through all nests, subnests, subsubnests,...
     Else
        UnNest.Add Item
     Endif
  Next Item
 End Function

所以最终结果应该是一个包含:
来自 aString 的“只是一个字符串”
9 个范围对象对应于 aRangeofManyCells 中的单元格 Range("A1:C3")
1个范围对象对应Range("A4")，来自aRangeofOneCell
对象 anObject、NestedObject 和 SubNestedObject

以上都是2x，因为我把TopColl作为Function 2x的参数

并且，
一个额外的 anObject，因为我将它作为参数添加到函数中
3个Range对象，分别对应Sheet1Q1、Sheet2Q2、Sheet3Q3

我知道这是一项艰巨的任务，但必须有某种方法来完成这个循环。
谢谢你的帮助!

Answer 1

此例程似乎可以解决您的一个用例。当然，它对我有用，尽管我没有传递除常规变量和数组之外的任何东西。

我无法克服的一个问题是我无法确定对象的类型。除非你能解决这个问题，否则我看不出如何实现你的整个目标。

Sub DeNestParamArray(RetnValue() As Variant, ParamArray Nested() As Variant)

  ' Coded Nov 2010

  ' Each time a ParamArray is passed to a sub-routine, it is nested in a one
  ' element Variant array.  This routine finds the bottom level of the nesting and
  ' sets RetnValue to the values in the original parameter array so that other routine
  ' need not be concerned with this complication.

  Dim NestedCrnt                As Variant
  Dim Inx                       As Integer

  NestedCrnt = Nested
  ' Find bottom level of nesting
  Do While True
    If VarType(NestedCrnt) < vbArray Then
      ' Have found a non-array element so must have reached the bottom level
      Debug.Assert False   ' Should have exited loop at previous level
      Exit Do
    End If
    If NumDim(NestedCrnt) = 1 Then
      If LBound(NestedCrnt) = UBound(NestedCrnt) Then
        ' This is a one element array
        If VarType(NestedCrnt(LBound(NestedCrnt))) < vbArray Then
          ' But it does not contain an array so the user only specified
          ' one value; a literal or a non-array variable
          ' This is a valid exit from this loop
            Exit Do
        End If
        NestedCrnt = NestedCrnt(LBound(NestedCrnt))
      Else
        ' This is a one-dimensional, non-nested array
        ' This is the usual exit from this loop
        Exit Do
      End If
    Else
      Debug.Assert False   ' This is an array but not a one-dimensional array
      Exit Do
    End If
  Loop

  ' Have found bottom level array.  Save contents in Return array.
  ReDim RetnValue(LBound(NestedCrnt) To UBound(NestedCrnt))
  For Inx = LBound(NestedCrnt) To UBound(NestedCrnt)
    If VarType(NestedCrnt(Inx)) = vbObject Then
      Set RetnValue(Inx) = NestedCrnt(Inx)
    Else
      RetnValue(Inx) = NestedCrnt(Inx)
    End If
  Next

End Sub
Public Function NumDim(ParamArray TestArray() As Variant) As Integer

  ' Returns the number of dimensions of TestArray.

  ' If there is an official way of determining the number of dimensions, I cannot find it.

  ' This routine tests for dimension 1, 2, 3 and so on until it get a failure.
  ' By trapping that failure it can determine the last test that did not fail.

  ' Coded June 2010. Documentation added July 2010.

  ' *  TestArray() is a ParamArray because it allows the passing of arrays of any type.
  ' *  The array to be tested in not TestArray but TestArray(LBound(TestArray)).
  ' *  The routine does not validate that TestArray(LBound(TestArray)) is an array.  If
  '    it is not an array, the routine return 0.
  ' *  The routine does not check for more than one parameter.  If the call was
  '    NumDim(MyArray1, MyArray2), it would ignore MyArray2.

  Dim TestDim                   As Integer
  Dim TestResult                As Integer

  On Error GoTo Finish

  TestDim = 1
  Do While True
    TestResult = LBound(TestArray(LBound(TestArray)), TestDim)
    TestDim = TestDim + 1
  Loop

Finish:

  NumDim = TestDim - 1

End Function