我假设您在 Excel 工作簿的三张工作表上有三个 ListObjects。
Sheet1 (tblParent)
Item
A
B
C
Sheet2 (tblChild)
Item Parent
z A
y A
w B
m C
n C
o C
p C
Sheet3 (tblGrain)
Grain Parent Data1 Data2 Data3
y.g1.g2.g3 y 0 TRUE 1/2/1970
w.g1.g2.g3 w 0 TRUE 9/5/1980
m.g1.g2.g3 m 100 TRUE 1/1/1949
n.g1.g2.g3 n 2 TRUE 1/1/1950
我将创建六个类模块，分别命名为CParent、CParents、CChild、CChildren、CGrain、CGrains。
家长
Private mcolParents As Collection
Private Sub Class_Initialize()
Set mcolParents = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolParents = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolParents.[_NewEnum]
End Property
Public Sub Add(clsParent As CParent)
If clsParent.ParentID = 0 Then
clsParent.ParentID = Me.Count + 1
End If
mcolParents.Add clsParent, CStr(clsParent.ParentID)
End Sub
Public Property Get Parent(vItem As Variant) As CParent
Set Parent = mcolParents.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolParents.Count
End Property
Public Sub FillFromRange(ByRef rParents As Range, ByRef rChildren As Range, ByRef rGrains As Range)
Dim vaParents As Variant
Dim i As Long
Dim clsParent As CParent
vaParents = rParents.Value
For i = LBound(vaParents, 1) To UBound(vaParents, 1)
Set clsParent = New CParent
With clsParent
.Name_ = vaParents(i, 1)
End With
Me.Add clsParent
clsParent.Children.FillFromRange rChildren, clsParent.Name_, rGrains
Next i
End Sub
CParent
Private mlParentID As Long
Private msName_ As String
Private mclsChildren As CChildren
Public Property Set Children(ByVal clsChildren As CChildren): Set mclsChildren = clsChildren: End Property
Public Property Get Children() As CChildren: Set Children = mclsChildren: End Property
Public Property Let ParentID(ByVal lParentID As Long): mlParentID = lParentID: End Property
Public Property Get ParentID() As Long: ParentID = mlParentID: End Property
Public Property Let Name_(ByVal sName_ As String): msName_ = sName_: End Property
Public Property Get Name_() As String: Name_ = msName_: End Property
Private Sub Class_Initialize()
Set mclsChildren = New CChildren
End Sub
Private Sub Class_Terminate()
Set mclsChildren = Nothing
End Sub
儿童
Private mcolChildren As Collection
Private Sub Class_Initialize()
Set mcolChildren = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolChildren = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolChildren.[_NewEnum]
End Property
Public Sub Add(clsChild As CChild)
If clsChild.ChildID = 0 Then
clsChild.ChildID = Me.Count + 1
End If
mcolChildren.Add clsChild, CStr(clsChild.ChildID)
End Sub
Public Property Get Child(vItem As Variant) As CChild
Set Child = mcolChildren.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolChildren.Count
End Property
Public Sub FillFromRange(ByRef rRng As Range, ByVal sParentName As String, ByRef rGrains As Range)
Dim vaValues As Variant
Dim i As Long
Dim clsChild As CChild
vaValues = rRng.Value
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
If vaValues(i, 2) = sParentName Then
Set clsChild = New CChild
With clsChild
.Name_ = vaValues(i, 1)
End With
Me.Add clsChild
clsChild.Grains.FillFromRange rGrains, clsChild.Name_
End If
Next i
End Sub
CChild
Private mlChildID As Long
Private msName_ As String
Private mclsGrains As CGrains
Public Property Set Grains(ByVal clsGrains As CGrains): Set mclsGrains = clsGrains: End Property
Public Property Get Grains() As CGrains: Set Grains = mclsGrains: End Property
Public Property Let ChildID(ByVal lChildID As Long): mlChildID = lChildID: End Property
Public Property Get ChildID() As Long: ChildID = mlChildID: End Property
Public Property Let Name_(ByVal sName_ As String): msName_ = sName_: End Property
Public Property Get Name_() As String: Name_ = msName_: End Property
Private Sub Class_Initialize()
Set mclsGrains = New CGrains
End Sub
Private Sub Class_Terminate()
Set mclsGrains = Nothing
End Sub
CGrains
Private mcolGrains As Collection
Private Sub Class_Initialize()
Set mcolGrains = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolGrains = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolGrains.[_NewEnum]
End Property
Public Sub Add(clsGrain As CGrain)
If clsGrain.GrainID = 0 Then
clsGrain.GrainID = Me.Count + 1
End If
mcolGrains.Add clsGrain, CStr(clsGrain.GrainID)
End Sub
Public Property Get Grain(vItem As Variant) As CGrain
Set Grain = mcolGrains.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolGrains.Count
End Property
Public Sub FillFromRange(ByRef rRng As Range, ByVal sChildName As String)
Dim vaValues As Variant
Dim i As Long
Dim clsGrain As CGrain
vaValues = rRng.Value
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
If vaValues(i, 2) = sChildName Then
Set clsGrain = New CGrain
With clsGrain
.Data1 = vaValues(i, 3)
.Data2 = vaValues(i, 4)
.Data3 = vaValues(i, 5)
End With
Me.Add clsGrain
End If
Next i
End Sub
CGrain
Private mlGrainID As Long
Private mlData1 As Long
Private mbData2 As Boolean
Private mdtData3 As Date
Public Property Let GrainID(ByVal lGrainID As Long): mlGrainID = lGrainID: End Property
Public Property Get GrainID() As Long: GrainID = mlGrainID: End Property
Public Property Let Data1(ByVal lData1 As Long): mlData1 = lData1: End Property
Public Property Get Data1() As Long: Data1 = mlData1: End Property
Public Property Let Data2(ByVal bData2 As Boolean): mbData2 = bData2: End Property
Public Property Get Data2() As Boolean: Data2 = mbData2: End Property
Public Property Let Data3(ByVal dtData3 As Date): mdtData3 = dtData3: End Property
Public Property Get Data3() As Date: Data3 = mdtData3: End Property
到目前为止所做的只是创建三个对象，建立它们之间的关系，并提供一种方法来用 Excel 范围中的数据填充它们。
关系建立在单个对象类（而不是复数）中。 CParent 类有一个包含CChildren 集合类的属性。该父级的所有子级都存储在该类中。 CChildren 类包含一堆 CChild 对象。每个CChild 对象都有一个属性CGrains，它保存了该孩子的所有颗粒。这是很多设置，但回报即将到来。
接下来，在一个标准模块中，我想创建填充类的过程。
Public gclsParents As CParents
Public Sub Initialize()
Set gclsParents = New CParents
gclsParents.FillFromRange Sheet1.ListObjects(1).DataBodyRange, Sheet2.ListObjects(1).DataBodyRange, Sheet3.ListObjects(1).DataBodyRange
End Sub
我为顶级集合类创建了一个公共变量，这样它就不会超出范围。在Intialize 中，我实例化了顶级集合类变量并调用FillFromRange 方法。我将我的三个 Excel 表传递给它，代码填充了所有类。
现在假设您想创建一个过程，列出所有父母、他们的孩子的数量以及他们的孩子的列表。
Public Sub ListChildren()
Dim sh As Worksheet
Dim vaWrite As Variant
If gclsParents Is Nothing Then Initialize
Set sh = ThisWorkbook.Worksheets.Add
vaWrite = gclsParents.ChildListToRange
sh.Range("A1").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite
End Sub
我的CParents 实例（保存在gclsParents 中）返回一个转储到新工作表的数组。输出看起来像
A 2 z,y
B 1 w
C 4 m,n,o,p
现在您必须创建ChildListToRange 方法。将此添加到 CParents 类
Public Property Get ChildListToRange() As Variant
Dim aReturn() As Variant
Dim clsParent As CParent
Dim lCnt As Long
ReDim aReturn(1 To Me.Count, 1 To 3)
For Each clsParent In Me
lCnt = lCnt + 1
aReturn(lCnt, 1) = clsParent.Name_
aReturn(lCnt, 2) = clsParent.Children.Count
aReturn(lCnt, 3) = clsParent.ChildListDelimited(",")
Next clsParent
ChildListToRange = aReturn
End Property
数组的前两列已经定义好了，但是我们需要在CParent类中创建一个ChildListDelimited属性。将此添加到CParent
Public Property Get ChildListDelimited(ByVal sDelim As String) As String
Dim clsChild As CChild
Dim aReturn() As String
Dim lCnt As Long
ReDim aReturn(1 To Me.Children.Count)
For Each clsChild In Me.Children
lCnt = lCnt + 1
aReturn(lCnt) = clsChild.Name_
Next clsChild
ChildListDelimited = Join(aReturn, sDelim)
End Property
您提供一个分隔符，此属性返回由该分隔符分隔的所有子项的字符串。
就是这样。您的第一份报告已完成。接下来，您要创建一个汇总Data1 与特定条件的报告。在标准模块中创建此过程
Public Sub SummarizeValues()
Dim sh As Worksheet
Dim vaWrite As Variant
Dim clsToSum As CParents
If gclsParents Is Nothing Then Initialize
Set sh = ThisWorkbook.Worksheets.Add
Set clsToSum = gclsParents.FilterByData2(True).FilterByData3(DateSerial(1950, 1, 1), ">=")
vaWrite = clsToSum.SummarizeGrainValues
sh.Range("A1").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite
End Sub
这看起来很像第一个过程，只是返回数组（要写入工作表）的CParents 属性不同。另外，我们做一些过滤。在第一个程序中，我们想要每个父母。现在我们只想要满足某些条件的父母。为此，创建几个 FilterBy 属性。在CParents添加
Public Property Get FilterByData2(ByVal lData As Long) As CParents
Dim clsParent As CParent
Dim clsNewParent As CParent
Dim clsChild As CChild
Dim clsReturn As CParents
Set clsReturn = New CParents
For Each clsParent In Me
Set clsNewParent = New CParent
clsNewParent.Name_ = clsParent.Name_
Set clsNewParent.Children = clsParent.Children.FilterByData2(lData)
If clsNewParent.Children.Count > 0 Then
clsReturn.Add clsNewParent
End If
Next clsParent
Set FilterByData2 = clsReturn
End Property
这是一个常见的过滤属性。它需要一个大的CParents 实例（在本例中为gclsParents）并返回一个较小的实例。如果它找到满足条件的子代，它会将父代添加到返回类中。否则不会。但是您需要将该标准传递给孩子们。将此添加到 CChildren 类
Public Property Get FilterByData2(ByVal lData As Long) As CChildren
Dim clsChild As CChild
Dim clsNewChild As CChild
Dim clsGrain As CGrain
Dim clsReturn As CChildren
Set clsReturn = New CChildren
For Each clsChild In Me
Set clsNewChild = New CChild
clsNewChild.Name_ = clsChild.Name_
Set clsNewChild.Grains = clsChild.Grains.FilterByData2(lData)
If clsNewChild.Grains.Count > 0 Then
clsReturn.Add clsNewChild
End If
Next clsChild
Set FilterByData2 = clsReturn
End Property
并将其添加到 CGrains 类
Public Property Get FilterByData2(ByVal lData As Long) As CGrains
Dim clsGrain As CGrain
Dim clsReturn As CGrains
Set clsReturn = New CGrains
For Each clsGrain In Me
If clsGrain.Data2 = lData Then
clsReturn.Add clsGrain
End If
Next clsGrain
Set FilterByData2 = clsReturn
End Property
所有返回 CParents 实例的所有内容，其中唯一的父母最终在 Data2 中有一个为 true 的颗粒。
从已经较小的CParents 实例中，我们添加另一个过滤器。将此添加到CParents
Public Property Get FilterByData3(ByVal dtData As Date, ByVal sComp As String) As CParents
Dim clsParent As CParent
Dim clsNewParent As CParent
Dim clsChild As CChild
Dim clsReturn As CParents
Set clsReturn = New CParents
For Each clsParent In Me
Set clsNewParent = New CParent
clsNewParent.Name_ = clsParent.Name_
Set clsNewParent.Children = clsParent.Children.FilterByData3(dtData, sComp)
If clsNewParent.Children.Count > 0 Then
clsReturn.Add clsNewParent
End If
Next clsParent
Set FilterByData3 = clsReturn
End Property
因为这个过滤器使用了一个不等式，它会变得有点复杂，我们马上就会看到。现在，将此添加到CChildren
Public Property Get FilterByData3(ByVal dtData As Date, ByVal sComp As String) As CChildren
Dim clsChild As CChild
Dim clsNewChild As CChild
Dim clsGrain As CGrain
Dim clsReturn As CChildren
Set clsReturn = New CChildren
For Each clsChild In Me
Set clsNewChild = New CChild
clsNewChild.Name_ = clsChild.Name_
Set clsNewChild.Grains = clsChild.Grains.FilterByData3(dtData, sComp)
If clsNewChild.Grains.Count > 0 Then
clsReturn.Add clsNewChild
End If
Next clsChild
Set FilterByData3 = clsReturn
End Property
并将其添加到CGrains
Public Property Get FilterByData3(ByVal dtData As Date, ByVal sComp As String) As CGrains
Dim clsGrain As CGrain
Dim clsReturn As CGrains
Dim bAdd As Boolean
Set clsReturn = New CGrains
For Each clsGrain In Me
Select Case sComp
Case ">="
bAdd = clsGrain.Data3 >= dtData
Case ">"
bAdd = clsGrain.Data3 > dtData
Case "<"
bAdd = clsGrain.Data3 < dtData
Case "<="
bAdd = clsGrain.Data3 <= dtData
Case Else
bAdd = clsGrain.Data3 = dtData
End Select
If bAdd Then
clsReturn.Add clsGrain
End If
Next clsGrain
Set FilterByData3 = clsReturn
End Property
您可以在CGrains 中看到我必须使用Select Case 来找出您想要的不等式。但除皱之外，它的作用与第一个过滤器相同。
现在你有一个变量clsToSum，它是一个CParents 实例，它只包含你想要的父母。您已经完成了过滤，现在您要做的就是总结一下。将此添加到CParents
Public Property Get SummarizeGrainValues() As Variant
Dim clsParent As CParent
Dim aReturn() As Variant
Dim lCnt As Long
ReDim aReturn(1 To Me.Count, 1 To 2)
For Each clsParent In Me
lCnt = lCnt + 1
aReturn(lCnt, 1) = clsParent.Name_
aReturn(lCnt, 2) = clsParent.SumData1
Next clsParent
SummarizeGrainValues = aReturn
End Property
现在您必须将SumData1 添加到CParent
Public Property Get SumData1() As Long
Dim lReturn As Long
Dim clsChild As CChild
Dim clsGrain As CGrain
For Each clsChild In Me.Children
For Each clsGrain In clsChild.Grains
lReturn = lReturn + clsGrain.Data1
Next clsGrain
Next clsChild
SumData1 = lReturn
End Property
循环遍历所有子节点中的所有颗粒并将它们相加。输出看起来像
A 0
B 0
C 2
现在基础架构已经完成，您可以创建任何您想要的报告方式。您只需设置所需的任何过滤器以及要报告的任何聚合属性。
我可能应该在顶部说，但是如果你把这三个表放在一个适当的关系数据库中，你可以用两个相当短的 SQL 语句来完成所有这些。
如果您想在工作簿中查看所有内容，请下载此http://dailydoseofexcel.com/excel/ClassParentChildGrains.zip