VBA编程技巧之浅谈数据结构（不定期持续更新，最后更新130411）

lee1892 · 发表于 2012-12-20 15:38

本帖最后由 lee1892 于 2012-12-23 13:04 编辑

队列与堆栈的使用

此处我们使用 Collection 集合对象来模拟队列与堆栈，并遵循其各自的规则。

下面的代码均不再上传附件，可以自行替代1楼附件中的＂不构造任何数据结构＂中的同名过程，以测试效果。

1、使用队列对本贴案例进行查询，类似之前的迭代查询过程，得到的结果是按层级优先进行排列的。
以下类似的注释就不再写了，参考前面的。
[code=vb]
Private Sub GetChildren(sNo$, aRows, nCount&, iLayer&)
Dim i&, cQueue As New Collection, aInfo
' cQueue 使用集合对象模拟的队列
' 此处使用的队列和后面用到的堆栈都是用来缓存后续工作流的
' 它们都被称作寄存器
' aInfo 含2个元素的数组，用于保存层数和地址
ReDim aInfo(1 To 2)
iLayer = 1
Do
      For i = 2 To UBound(aData)
         If sNo = aData(i, nParentCol) Then
            aInfo(1) = iLayer
            aInfo(2) = i
            cQueue.Add aInfo ' 找到符合项，进入队列末端
            ' 集合对象的Add方法在不指定Before和After参数时，默认添加于末端
         End If
      Next
      If cQueue.Count > 0 Then
         ' 如果队列数量大于0，则继续
         aInfo = cQueue.Item(1) ' 从队列前端获得下一项待查询的信息
         iLayer = aInfo(1) + 1
         sNo = aData(aInfo(2), nItemCol) ' 获得下一次查询工作的产品/部件编号
         nCount = nCount + 1 ' 获得的结果的计数器 +1
         aRows(1, nCount) = aInfo(1) ' 添加到结果数组中
         aRows(2, nCount) = aInfo(2)
         cQueue.Remove 1 ' 将队列前端的项目删除，循环进入下一次查询
      Else
         ' 如果队列数量等于0，则查询工作结束
         Exit Do
      End If
Loop
Set cQueue = Nothing
End Sub
[/code]

2、使用堆栈对本贴案例进行查询，类似之前的迭代查询过程，得到的结果是按层级优先进行排列的，并且由于是后进先出，所以每层内容在同层中的顺序是颠倒的。

Private Sub GetChildren(sNo$, aRows, nCount&, iLayer&)
Dim i&, cStack As New Collection, aInfo
iLayer = 1
ReDim aInfo(1 To 2)
Do
For i = 2 To UBound(aData)
If sNo = aData(i, nParentCol) Then
aInfo(1) = iLayer
aInfo(2) = i
cStack.Add aInfo ' 找到符合项，进入堆栈末端
End If
Next
If cStack.Count > 0 Then
aInfo = cStack.Item(cStack.Count) ' 获得堆栈末端数据，作为下一次查询的信息
iLayer = aInfo(1) + 1
sNo = aData(aInfo(2), nItemCol)
nCount = nCount + 1
aRows(1, nCount) = aInfo(1)
aRows(2, nCount) = aInfo(2)
cStack.Remove cStack.Count ' 删除堆栈末端项，循环进入下一次查询
Else
Exit Do
End If
Loop
Set cStack = Nothing
End Sub

复制代码

=================================================================
Original Post （递归循环查找的代码，删，详见1楼附件）

估计是代码量最少的办法了，什么数据结构都不构造，只是在读取数据时辨认出哪些是产品并作成一个数组，然后每次查产品的 BOM 展开时，递归循环查找。
显然，效率也是最低的，如果有数万甚至数十万行原始数据，BOM层数有个7、8层，估计就很慢了。
ParseData过程就没啥好看的了，把循环查找的代码贴出来。同前，附件在1楼。

香川群子 · 发表于 2012-12-20 16:18

lee1892 发表于 2012-12-19 15:14
改写成用数组构造双向链表，貌似初始化的速度快了很多啊，而且内存占用也很小
看来字典多重嵌套不是什么好 ...

没错。

字典嵌套的代码结构便于理解、便于设计，但实际代码运行速度就很不理想了。

清风_ll · 发表于 2012-12-20 16:44

释放数组可使用Erase语句。

lee1892 · 发表于 2012-12-20 16:56

本帖最后由 lee1892 于 2012-12-24 16:42 编辑

使用队列和堆栈获得正确的顺序

1、队列加塞

在前文中使用队列来缓存后续的工作，由于受队列的限制，队列中层数高的总是在层数低的后面，导致获得的结果是按层级优先排列的，显然不是我们想要的结果。

一种解决方法是，在从队列中取得前端元素并写入结果数组时，采取插入到正确位置的办法，而不是写入到数组的末尾。
另一种办法则破坏了队列的规则，即在后续查询获得结果时不是在末端进入队列，而是插入队列。

下面的代码采用的是第二个方法。
[code=vb]
Private Sub GetChildren(sNo$, aRows, nCount&, iLayer&)
Dim i&, nIndex&, cQueue As New Collection, aInfo, nQueCount&
iLayer = 1
ReDim aInfo(1 To 3)
nIndex = 0 ' 用来保留循环初次查到结果时，其应插入的位置
cQueue.Add Item:=0, Key:="KEY" & nIndex
' 由于是插入添加至队列，所以初始化时先加一个进入队列，
' 可将其理解为第一层的父节点
Do
      For i = 2 To UBound(aData)
         If sNo = aData(i, nParentCol) Then
            nQueCount = nQueCount + 1
            ' 队列产生过的元素计数变量，用于生成队列中元素的不重复编号
            aInfo(1) = iLayer
            aInfo(2) = i
            aInfo(3) = nQueCount
            ' 信息记录数组多一项，用以记录队列元素编号
            cQueue.Add Item:=aInfo, Key:="KEY" & nQueCount, After:="KEY" & nIndex
            ' 在队列中插入，在其父节点编号nIndex之后
            nIndex = nQueCount
            ' 在第一个子节点后的项目应插入前一个兄弟节点之后
         End If
      Next
      If cQueue.Count > 1 Then
         cQueue.Remove 1 ' 由于初始化时添加过一个项目，所以先删
         ' 此后循环时，第一个总是上一次查找用的信息
         aInfo = cQueue.Item(1)
         iLayer = aInfo(1) + 1
         sNo = aData(aInfo(2), nItemCol)
         nIndex = aInfo(3) ' 下次查找时，以队列第一项的编号作为插入位置标记
         nCount = nCount + 1
         aRows(1, nCount) = aInfo(1)
         aRows(2, nCount) = aInfo(2)
      Else
         Exit Do
      End If
Loop
cQueue.Remove 1: Set cQueue = Nothing
' 队列內还剩有最后一个元素
End Sub
[/code]

2、堆栈倒查

前面的使用堆栈的代码获得的顺序虽然是按从属关系排列的，但同层中则是原顺序的倒序。同样也有两个方法解决。

一个是在写入结果数组中时总是在其前端写入。二则是在查询时反向查找，即把For语句改成：

For i = UBound(aData) To 2 Step -1

3、用堆栈模拟递归

我们知道递归的实现是编译器在内存中构建了堆栈寄存器保留了当前执行的结果，以使得当递归返回时能从前次执行的停止处开始接着执行。

那么我们也可以使用自构建的堆栈寄存器来达到这一目的。实际上，理解好下面这段代码，对理解递归是有很大帮助的。值得注意的是，下面这段代码中，iLayer这个参数完全没有使用，这是由于在堆栈中自始至终总是只保留了当前查询的各级上级节点，所以堆栈中的数量即是层数。为了帮助理解，可以将层数的计算代码加入，参考之前的递归代码，看看哪里是该+1哪该-1。

下面的代码直接在平板上写的，明儿看看对不～

Private Sub GetChildren(sNo$, aRows, nCount&, iLayer&)
Dim i&, cStack As New Collection, nLastTimeRow&, nStackCount&, nIndex&
nLastTimeRow = 1 ' 初始值1
Do
For i = nLastTimeRow + 1 To UBound(aData)
If sNo = aData(i, nParentCol) Then
nCount = nCount + 1
aRows(1, nCount) = cStack.Count + 1 ' 层数即为堆栈中的元素数量 +1
aRows(2, nCount) = i
' 如同之前的递归代码，进寄存器时写入结果
' 而不是像前面的几个出寄存器时写入
cStack.Add nCount ' 找到符合项，进入堆栈末端，只记录结果的编号
Exit For
End If
Next
If cStack.Count ＝ 0 Then Exit Do ' 如果堆栈为空则退出查询
nStackCount = cStack.Count
nIndex = cStack.Item(nStackCount) ' 取得堆栈末端记录的结果数组编号
If i <＝ UBound(aData) Then
' 如果 i 不大于原始数据数量，说明本次循环查到了符合项，需要查其子节点
sNo = aData(aRows(2, nIndex), nItemCol)
' 子节点的所属产品/部件编号(GC列)是本节点的部件/材料编号(SGC列)
nLastTimeRow = 1 ' 查子节点由第一项开始
Else
' 否则说明本次查询结束，应返回查询兄弟节点
sNo = aData(aRows(2, nIndex), nParentCol)
' 兄弟节点的所属产品/部件编号与本节点相同，即本节点的GC列
nLastTimeRow = aRows(2, nIndex) ' 这个写错了，应该是2，用平板写的时候写成1了，55~~
' 查找兄弟节点时从本节点地址开始
cStack.Remove cStack.Count
' 本节点的子节点查询结束，故将本节点从堆栈中删除
End If
Loop
Set cStack = Nothing
End Sub

复制代码

小结

至此，我们已经了解了数据结构中的基础知识，锻炼了迭代、递归的思维逻辑。经常看到论坛里有因为不知道循环次数（层的数量）而不知所措的，时常有人提出的方法是假设有足够大的层数之类的，相信通过前面的学习，我们已经有足够多的方法来应付了。

此后的代码，我们都将使用递归的方法，不要担心最开始提到的那个递归5000多次使得VBA堆栈空间溢出的问题，通常在我们处理的现实世界中的问题不太可能碰到这样极端的情况，即便有也可以通过数据结构和算法的优化避免。

=============================================

Original Post

用平板编辑贴子会出乱码，讨厌啊～

dhslxx · 发表于 2012-12-20 17:00

楼主为什么要自己构造数据结构呢，用XML来表达BOM不好吗

lee1892 · 发表于 2012-12-27 18:51

本帖最后由 lee1892 于 2012-12-27 18:56 编辑

使用案例-两棵树的比较

看到一个帖子：多级物料清单（BOM）的比较，10年的老贴了。有参与讨论的，有打酱油的，也有纯粹灌水的，就是没人提出解决方法。

这里仅拿来供学习树形结构用。

该案例，实质上是比较两棵结构、内容相近的树，其内容是某个产品的在不同时间的物料清单。要求根据物料编码的变化，确定新旧两个清单中对应项目的变化情况。

具体可见本贴 1楼附件。运行“比较结果”表单内的CompareBOMs过程，未作按钮。原楼主对比较的要求见该附件的BOM1表。

其定义当两个物料编号仅后两位不同时，这两个物料的关系是“变更”。

实际上还存在很多可能，原楼主并没有定义，如下：
1、如两个物料节点的编号相同，则两者关系为“相同”，同时其下的所有子节点应一一对应的“相同”
2、如两个物料节点的编号仅尾部两个代码不同，则两者关系为“变更”，同时其下的所有子节点至少有一对是“变更”关系或是“删除/新增”关系。
3、如两个物料节点的编号有至少6个（或其它数量）相同，则两者关系为“对应”的“删除/新增”，同时其下的所有子节点不再对比，分开罗列。此处，似应增加一个替代的关系。
4、树1或是树2在另一棵树上没有“对应”，则分别是“删除”和“新增”

按照如上定义，就可以实施对比了。1楼的附件中，对一个有对应关系的节点对的所有子节点进行了循环对比，所以不依托于原有数据出现的顺序，而只依赖于其在树中的位置。

实际上对代码的进一步完善，可以完成上面提到的1、2两项的检查的功能。

在1楼的附件中有比较详细的注释，就不再分析代码了。列出节点的自定义数据类型代码：
[code=vb]
Private Type TREE_NODE
Layer As Long ' 记录层数
Code As String ' 记录编码
Children() As Long ' 子节点地址数组
Status As ITEM_STATUS ' 状态
LinkedNode As Long ' 链接对应节点地址
End Type
[/code]

有找到比较有意思的帖子，不妨跟贴说一下，我们一起来分析一下解决方法，当然是涉及到数据结构的~~

fecmen · 发表于 2012-12-28 16:36

谢谢分享！

香川群子 · 发表于 2012-12-21 10:12

清风_ll 发表于 2012-12-20 16:44
释放数组可使用Erase语句。

数组变量其实最好不要事先定义，
或者如果要事先定义的话，也推荐使用Redim语句。或仅仅Dim arr()这样子

因为假如直接使用 Dim a(9) 的话，用Erase语句只能清空，不能完全释放内存。

Sub test()
Dim a(9) '直接定义数组类型，以及数组大小，且今后大小不变。
ReDim b(9) '定义数组以及大小，但大小可变。
Dim c() '仅仅定义变量类型

For i = 0 To 9
a(i) = i
b(i) = i
Next
c = a
Erase a
Erase b
Erase c

' ReDim a(9) '如果事先定义了Dim a(9)，那以后就不能Redim操作了。
ReDim b(9) '或者 ReDim b(19) '可以改变数组大小
ReDim c(9) '或者 ReDim c(19) '可以改变数组大小

arr = [a1:a10]
brr = Application.Transpose([a1:a10])
Erase arr
Erase brr

End Sub

624859791 · 发表于 2012-12-21 10:20

想问下，能否在做bom表时，在bom表中多加一个column输入对应的库存商品品名？如此  1,只用筛选库存商品品名就能得到A产品的bom结构 2,通过对item排序,能更好的表达效果 3，数据维护起来应该更容易些。
比如 item 母件品名子件品名子件用量单位库存商品品名
   1    A          A1       1    PCS    A
      2    A1       A2       2    PCS    A
A2-->A1-->A

清风_ll · 发表于 2012-12-21 11:50

香川群子发表于 2012-12-21 10:12
数组变量其实最好不要事先定义，
或者如果要事先定义的话，也推荐使用Redim语句。或仅仅Dim arr()这样子 ...

Erase 语句
重新初始化大小固定的数组的元素，以及释放动态数组的存储空间。

对于是否使用动态数组应根据实际情况，如果数组固定则不应使用动态数组，直接定义，可减少内存占用。如不定则需动态定义。

		自动登录	找回密码
密码			免费注册

[原创] VBA编程技巧之浅谈数据结构（不定期持续更新，最后更新130411）

评分

评分

评分

最新热点 /1

[原创] VBA编程技巧 之 浅谈数据结构 （不定期持续更新，最后更新130411）

评分

评分

评分

最新热点 /1

[原创] VBA编程技巧之浅谈数据结构（不定期持续更新，最后更新130411）