Question

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

这将是这样的，让我们从创建一个用例开始：

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

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

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

所以最终结果应该是一个包含的集合：＆＃34;只是一个字符串＆＃34;来自aString 对应于aRangeofManyCells的单元格范围（＆＃34; A1：C3＆＃34;）的9个范围对象 1范围对象，对应于范围（＆＃34; A4＆＃34;），来自aRangeofOneCell 对象anObject，NestedObject和SubNestedObject

以上所有2x，因为我将TopColl作为函数2x的参数

而且，另外一个anObject，因为我添加了它作为函数的参数 3个范围对象，对应于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

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

1 个答案: