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

lee1892

链表（Linked List）

我们知道数组（Array，个人认为叫阵列更为恰当，毕竟其元素可以是任何数据）是顺序存储，即划分一个连续的存储区域将数据按照先后顺序存放，但取用时则可以是随机的取用任意一个元素并直接寻址获得。

链表则是在每一个节点除保留本节点数据外，另保存了下一个节点的地址。这样就可以随机的存储数据，但在取用时则必须由第一个节点开始进行遍历直到获得需要的节点，换言之即顺序取用。相对于数组，链表的另一个优势是插入操作，只需断开一个链接并将待插入节点与前后两个节点进行链接即可，而不用像数组需要从插入点开始向后遍历。

链表一个最为广泛的用途是用来构建其他复杂数据结构。另外，由于VBA并没有提供对内存直接访问的接口，所以此文中我们都以数组来模拟内存，数组的元素编号则代表了地址。

通常将列表分为单向链表、双向链表、多向链表、循环链表、块状链表等等。

下面这段代码实现了对一个双向链表的排序，作为对比将快速排序也放了进来

1. 
   
2. Const DATA = 1
   
3. Const L_NEXT = 2
   
4. Const L_PREV = 3
   
5. 
   
6. Sub TestSpeed()
   
7.     Dim t#, aData_1!(), aData_2!(), aList(), i&, nPoint&
   
8.     Const NUM = 10 ^ 4
   
9.     aData_1 = RandomArray(NUM)
   
10.     If UBound(aData_1) = 0 Then Exit Sub
    
11.     aData_2 = aData_1
    
12.     t = Timer
    
13.     Call QuickSort(aData_1, 1, UBound(aData_1))
    
14.     Debug.Print "使用数组原地排序用时：" & Timer - t
    
15.     t = Timer
    
16.     ReDim aList(0 To UBound(aData_2), 1 To 3)
    
17.     aList(0, L_NEXT) = 1
    
18.     For i = 1 To UBound(aData_2)
    
19.         aList(i, DATA) = aData_2(i): aList(i, L_NEXT) = i + 1: aList(i, L_PREV) = i - 1
    
20.     Next
    
21.     Call QuickSortByLinkedList(aList, 1, UBound(aList))
    
22.     nPoint = aList(0, L_NEXT)
    
23.     For i = 1 To UBound(aList)
    
24.         aData_2(i) = aList(nPoint, DATA)
    
25.         nPoint = aList(nPoint, L_NEXT)
    
26.     Next
    
27.     Debug.Print "使用链表排序用时：" & Timer - t
    
28.     Erase aData_1: Erase aData_2: Erase aList
    
29. End Sub
    
30. 
    
31. Function RandomArray(nCount&)
    
32.     Dim aData!(), i&
    
33.     If nCount < 1 Then
    
34.         ReDim aData(0)
    
35.     Else
    
36.         Randomize
    
37.         ReDim aData(1 To nCount)
    
38.         For i = 1 To nCount
    
39.             aData(i) = Rnd
    
40.         Next
    
41.     End If
    
42.     RandomArray = aData
    
43. End Function
    
44. 
    
45. Sub QuickSort(aData!(), nLeft&, nRight&)
    
46.     Dim i&, j&, gKey!, gTemp!
    
47.     If nLeft >= nRight Then Exit Sub
    
48.     gKey = aData(nLeft)
    
49.     i = nLeft + 1: j = nRight
    
50.     Do
    
51.         Do While i <= nRight
    
52.             If aData(i) > gKey Then Exit Do
    
53.             i = i + 1
    
54.         Loop
    
55.         Do While j > nLeft
    
56.             If aData(j) < gKey Then Exit Do
    
57.             j = j - 1
    
58.         Loop
    
59.         If i >= j Then Exit Do
    
60.         gTemp = aData(i): aData(i) = aData(j): aData(j) = gTemp
    
61.     Loop
    
62.     gTemp = aData(nLeft): aData(nLeft) = aData(j): aData(j) = gTemp
    
63.     Call QuickSort(aData, nLeft, j)
    
64.     Call QuickSort(aData, j + 1, nRight)
    
65. End Sub
    
66. 
    
67. Sub QuickSortByLinkedList(aList(), nLeft, nRight)
    
68.     Dim i&, gKey!, nKeyIndex&, nPoint&
    
69.     If nLeft = nRight Then
    
70.         Exit Sub
    
71.     End If
    
72.     nKeyIndex = nLeft
    
73.     gKey = aList(nKeyIndex, DATA)
    
74.     i = nLeft
    
75.     Do
    
76.         i = aList(i, L_NEXT)
    
77.         If aList(i, DATA) <= gKey Then
    
78.             nPoint = aList(i, L_PREV)
    
79.             aList(aList(i, L_PREV), L_NEXT) = aList(i, L_NEXT)
    
80.             If i <> nRight Then
    
81.                 aList(aList(i, L_NEXT), L_PREV) = aList(i, L_PREV)
    
82.             Else
    
83.                 nRight = aList(i, L_PREV)
    
84.             End If
    
85.             aList(i, L_PREV) = aList(nKeyIndex, L_PREV)
    
86.             aList(i, L_NEXT) = nKeyIndex
    
87.             If nKeyIndex <> nLeft Then
    
88.                 aList(aList(nKeyIndex, L_PREV), L_NEXT) = i
    
89.             Else
    
90.                 If aList(0, L_NEXT) = nLeft Then
    
91.                     aList(0, L_NEXT) = i
    
92.                 End If
    
93.                 nLeft = i
    
94.             End If
    
95.             aList(nKeyIndex, L_PREV) = i
    
96.             i = nPoint
    
97.         End If
    
98.         If i = nRight Then Exit Do
    
99.     Loop
    
100.     If nLeft <> nKeyIndex Then
     
101.         Call QuickSortByLinkedList(aList, nLeft, aList(nKeyIndex, L_PREV))
     
102.     End If
     
103.     If nKeyIndex <> nRight Then
     
104.         Call QuickSortByLinkedList(aList, aList(nKeyIndex, L_NEXT), nRight)
     
105.     End If
     
106. End Sub
     

复制代码

lee1892

使用链表构建树形结构

本打算写的细点，不耐烦啊~~
嗯，想想还是写一个吧，单向链表实现树形结构。把每一行数据看作是一个节点，创建数组aNodes，其元素下标对应于原始数据节点地址（即行号），其元素内容对应该节点的子节点地址数组（即行号数组），并在其后追加了 产品 的节点。创建cProducts集合对象，作为每个产品树的根节点的索引。附件在1楼。ParseData的代码如下：

[code=vb]
Private Sub ParseData(sShtName As String)
    Dim i&, j&, sItemNo$, sParentNo$, aChildren()
    Dim dItems As Object, dProducts As Object, dParents As Object
    aData = Sheets(sShtName).Cells(1, 1).CurrentRegion
    For i = 1 To UBound(aData, 2)
        If aData(1, i) = BOM_ITEM_NO_TITLE Then
            nItemCol = i
        ElseIf aData(1, i) = BOM_PARENT_NO_TITLE Then
            nParentCol = i
        End If
    Next
    Set dItems = CreateObject("scripting.dictionary")
    Set dParents = CreateObject("scripting.dictionary")
    For i = 2 To UBound(aData)
        sItemNo = aData(i, nItemCol)
        sParentNo = aData(i, nParentCol)
        If Not dParents.exists(sParentNo) Then
            ReDim aChildren(1 To 1)
            aChildren(1) = i
            dParents(sParentNo) = aChildren
        Else
            aChildren = dParents(sParentNo)
            ReDim Preserve aChildren(1 To UBound(aChildren) + 1)
            aChildren(UBound(aChildren)) = i
            dParents(sParentNo) = aChildren
        End If
        dItems(sItemNo) = i
    Next
    Set dProducts = CreateObject("scripting.dictionary")
    ReDim aNodes(1 To UBound(aData))
    ReDim aProducts(1 To UBound(aData))
    Set cProducts = New Collection
    For i = 2 To UBound(aData)
        sParentNo = aData(i, nParentCol)
        sItemNo = aData(i, nItemCol)
        If Not dItems.exists(sParentNo) Then
            If Not dProducts.exists(sParentNo) Then
                ReDim aChildren(1 To 1)
                aChildren(1) = i
                cProducts.Add aChildren, sParentNo
                dProducts(sParentNo) = i
                aProducts(dProducts.Count) = sParentNo
            Else
                aChildren = cProducts(sParentNo)
                ReDim Preserve aChildren(1 To UBound(aChildren) + 1)
                aChildren(UBound(aChildren)) = i
                cProducts.Remove sParentNo
                cProducts.Add aChildren, sParentNo
            End If
        End If
        If dParents.exists(sItemNo) Then
            aNodes(i) = dParents(sItemNo)
        Else
            ReDim aChildren(0)
            aNodes(i) = aChildren
        End If
    Next
    ReDim Preserve aProducts(1 To cProducts.Count)
    ReDim Preserve aNodes(1 To UBound(aNodes) + cProducts.Count)
    For i = 1 To cProducts.Count
        j = UBound(aNodes) - cProducts.Count + i
        aNodes(j) = cProducts(aProducts(i))
        cProducts.Remove aProducts(i)
        cProducts.Add j, aProducts(i)
    Next
    dItems.RemoveAll:    Set dItems = Nothing
    dProducts.RemoveAll: Set dProducts = Nothing
    dParents.RemoveAll:  Set dParents = Nothing
End Sub
[/code]

其遍历子节点的代码则非常简单：
[code=vb]
Private Sub GetChildren(nNode, aRows, nCount&, iLayer&)
    Dim i&, j&, nRow&, aChildren
    iLayer = iLayer + 1
    aChildren = aNodes(nNode)
    For i = 1 To UBound(aChildren)
        nCount = nCount + 1
        aRows(1, nCount) = iLayer
        aRows(2, nCount) = aChildren(i)
        Call GetChildren(aChildren(i), aRows, nCount, iLayer)
    Next
    iLayer = iLayer - 1
End Sub
[/code]

双向链表的具体实现建议参考1楼的，使用数组结合自定义数据类型构造双向链表，这个附件。代码本身就跟大白话一样的。值得注意的是，这里的节点不再对应一行数据，而是一个 产品/部件/材料 的编号。

至于使用字典嵌套的那个建议就不要参考了，一是一开始把GetChildren这个过程和获得查询结果的内容混在一起写了，使得代码的功能性不是独立的，也就是说缺乏通用性；二是字典嵌套实在是很占内存，而且初始化的时候非常慢，再有就是感觉不管是全局变量还是局部变量很容易丢失。

自定义数据类型的部分：
[code=vb]
Private Type NODE_INFO
    ParentNo As String
    RowNo As Long
End Type

Private Type NODE_TYPE
    ItemNo As String
    Nodes() As NODE_INFO
    NodesCount As Long
    Parents() As Long
    ParentsCount As Long
    Children() As Long
    ChildrenCount As Long
End Type

Private aData
Private aNodes() As NODE_TYPE
Private nNodeCount As Long
[/code]

ParseData的代码如下
[code=vb]
Private Sub ParseData(sShtName As String)
    Dim i&, j&, aKeys
    Dim nParentCol&, nItemCol&, sParentNo$, sItemNo$
    Dim nNodeNo&, nParentNo&
    Dim dIndex As Object
    Dim aNodeInfo(), aLinks(), t As Double
    t = Timer
    aData = Sheets(sShtName).Cells(1, 1).CurrentRegion
    Set dIndex = CreateObject("scripting.dictionary")
    For i = 1 To UBound(aData, 2)
        If aData(1, i) = BOM_ITEM_NO_TITLE Then
            nItemCol = i
        ElseIf aData(1, i) = BOM_PARENT_NO_TITLE Then
            nParentCol = i
        End If
    Next
    ReDim aNodes(1 To UBound(aData) * 2)
    ReDim aLinks(0)
    For i = 2 To UBound(aData, 1)
        sItemNo = aData(i, nItemCol)
        sParentNo = aData(i, nParentCol)
        If Not dIndex.exists(sItemNo) Then
            nNodeCount = nNodeCount + 1
            dIndex(sItemNo) = nNodeCount
            With aNodes(nNodeCount)
                .ItemNo = sItemNo
                ReDim .Nodes(0): ReDim .Parents(0): ReDim .Children(0)
            End With
        End If
        nNodeNo = dIndex(sItemNo)
        With aNodes(nNodeNo)
            For j = 1 To .NodesCount
                If .Nodes(j).ParentNo = sParentNo Then Exit For
            Next
            If j <= .NodesCount Then
                ' 检查到有重复的（部件编号，所属部件编号）对
                Debug.Print "Why there are dupliated items?" & vbCr & _
                            BOM_ITEM_NO_TITLE & ":" & sItemNo & " -> " & _
                            BOM_PARENT_NO_TITLE & ":" & sParentNo & vbCr & _
                            "ROW NO: " & .Nodes(j).RowNo & " VS " & i
            End If
            .NodesCount = .NodesCount + 1
            ReDim Preserve .Nodes(.NodesCount)
            .Nodes(.NodesCount).ParentNo = sParentNo
            .Nodes(.NodesCount).RowNo = i
        End With
    Next
    For i = 2 To UBound(aData, 1)
        sParentNo = aData(i, nParentCol)
        If Not dIndex.exists(sParentNo) Then
            nNodeCount = nNodeCount + 1
            dIndex(sParentNo) = nNodeCount
            With aNodes(nNodeCount)
                .ItemNo = sParentNo
                ReDim .Nodes(0): ReDim .Parents(0): ReDim .Children(0)
            End With
        End If
    Next
    ReDim Preserve aNodes(1 To nNodeCount)
    ' 建立节点之间的链接
    aKeys = dIndex.keys
    For i = LBound(aKeys) To UBound(aKeys)
        nNodeNo = dIndex(aKeys(i))
        With aNodes(nNodeNo)
            For j = 1 To .NodesCount
                sParentNo = .Nodes(j).ParentNo
                If dIndex.exists(sParentNo) Then
                    nParentNo = dIndex(sParentNo)
                    .ParentsCount = .ParentsCount + 1
                    ReDim Preserve .Parents(.ParentsCount)
                    .Parents(.ParentsCount) = nParentNo
                    With aNodes(nParentNo)
                        .ChildrenCount = .ChildrenCount + 1
                        ReDim Preserve .Children(.ChildrenCount)
                        .Children(.ChildrenCount) = nNodeNo
                    End With
                End If
            Next
        End With
    Next
    dIndex.RemoveAll: Set dIndex = Nothing
    Debug.Print "自定义数据类型构造双向链表用时：" & Round(Timer - t, 2) & " 秒"
End Sub
[/code]

遍历树下全部节点的代码：
[code=vb]
Private Sub GetChildren(nNodeNo&, aRows, nCount&, iLayer&)
    Dim i&, j&, nRow&, nChildNodeNo&
    With aNodes(nNodeNo)
        If .ChildrenCount = 0 Then Exit Sub
        iLayer = iLayer + 1
        For i = 1 To .ChildrenCount
            nCount = nCount + 1
            nChildNodeNo = .Children(i)
            For j = 1 To aNodes(nChildNodeNo).NodesCount
                If .ItemNo = aNodes(nChildNodeNo).Nodes(j).ParentNo Then
                    nRow = aNodes(nChildNodeNo).Nodes(j).RowNo
                    Exit For
                End If
            Next
            aRows(1, nCount) = iLayer
            aRows(2, nCount) = nRow
            Call GetChildren(nChildNodeNo, aRows, nCount, iLayer)
        Next
    End With
    iLayer = iLayer - 1
End Sub
[/code]

有时间再考虑写注释吧

lee1892

树（Tree）和二叉树（Binary Tree）

由n个有限节点组成的一个具有层次关系的集合，称为树是由于其像一个倒着的树，根在上，叶在下。

其有如下特点：
1、每个节点有0个或多个子节点
2、每个子节点只有一个父节点

如此看来，前面用双向链表构造的不是严格意义上的树结构，因为每一个节点都被定义了有可能有多个父节点。

对树的遍历，可以分为深度优先和广度优先两种形式。所谓深度优先，即对于任意节点，总是先访问其子节点再访问其兄弟节点，可采用堆栈或递归的方式实现。而所谓广度优先，则是对任意节点，总是先访问其兄弟节点再访问其子节点，可利用队列或迭代的方式来实现。可参考之前的讨论。

常看到有人但凡提到树形结构会以二叉树呼之，其实这是错误的，树形结构并没有限制每个节点的分支（即子节点）的数量，而二叉树是严格定义了每个节点都只能存在不大于2个的子节点。一个二叉树的节点数据类型可以这样定义：
[code=vb]
Type BST_NODE
    DataAddress As Long ' 节点数据的地址
    RightChild As Long ' 指向右子节点
    LeftChild As Long ' 指向左子节点
End Type
[/code]

一个普通树形结构或称n叉树可以转化为一个二叉树，对于每一个节点，其兄弟节点作为其右子节点进行链接，而其子节点作为其左子节点进行链接。这样转化后的树被称为左子右兄弟树（Left Child Right Sibling Binary Tree）


对于一个二叉树的深度遍历，又可分为先序遍历（Pre-Order Visiting）、中序遍历（In-Order Visiting）和后序遍历（Post-Order Visiting），伪代码如下。
[code=vb]
先序遍历(根节点)
    结果数组 <- 根节点
    如果 有左子节点 则 先序遍历(左子节点)
    如果 有右子节点 则 先序遍历(右子节点)
结束

中序遍历(根节点)
    如果 有左子节点 则 中序遍历(左子节点)
    结果数组 <- 根节点
    如果 有右子节点 则 中序遍历(右子节点)
结束

后序遍历(根节点)
    如果 有左子节点 则 后序遍历(左子节点)
    如果 有右子节点 则 后序遍历(右子节点)
    结果数组 <- 根节点
结束
[/code]

对于一个由n叉树转化的二叉树，上述不同的遍历方式会带来不同的顺序。有兴趣的可以思考一下如何将一个n叉树转化为二叉树，对二叉树的不同遍历方式又分别带来的是什么样的顺序。

xxxer383

好好学习一下

lee1892

二叉查找树（Binary Searching Tree）的 向左走、向右走

如果一个二叉树的每个节点都遵循：其左子节点小于或等于该节点、而其右子节点都大于该节点，那么称为二叉查找树，或二叉排序树。对一个二叉查找树进行中序遍历（左优先）就可以得到一个递增的排序，而进行右优先的中序遍历，则可以得到递减的排序。

下面的代码使用二叉查找树实现了对一个变体一维数组的排序
[code=vb]
Sub BSTSort(aData)
    Dim i&, aBST, nPnt&, nLB&, nUB&, iDir%, arr
    nLB = LBound(aData): nUB = UBound(aData)
    ReDim aBST(nLB To nUB, -1 To 0)
    For i = nLB + 1 To nUB
        nPnt = nLB
        Do
            iDir = aData(i) <= aData(nPnt) ' 向左还是向右？
            If IsEmpty(aBST(nPnt, iDir)) Then
                aBST(nPnt, iDir) = i: Exit Do
                ' 左或右是空的，留下来
            Else
                nPnt = aBST(nPnt, iDir)
                ' 左或右是不空，继续走
            End If
        Loop
    Next
    arr = aData
    Call InOrder(aBST, arr, aData, nLB, nLB - 1)
End Sub

Sub InOrder(aBST, arr, aData, nPnt, nCount&)
    If Not IsEmpty(aBST(nPnt, -1)) Then
        Call InOrder(aBST, arr, aData, aBST(nPnt, -1), nCount)
        ' 有左子节点，继续向左走
    End If
    nCount = nCount + 1
    aData(nCount) = arr(nPnt)
    ' 左子节点已经被访问过或不存在，取得当前节点数据
    If Not IsEmpty(aBST(nPnt, 0)) Then
        Call InOrder(aBST, arr, aData, aBST(nPnt, 0), nCount)
        ' 有右子节点，向右走
    End If
End Sub

[/code]

实际上二叉查找树与之前的那个快速排序是基于一个逻辑的，快速排序的逻辑是对一组数据以一个参考值为基准进行比较，小的放左边、大的放右边，然后对左右两边再分别以新的基准进行比较，二叉查找树也是同样的方式。而快速排序在一些特殊顺序的数组的时候，其效率是会退化的，而同样的数据对二叉查找树也会产生一样的效果。设想一个已排序的数组会使得生成的二叉查找树的树高等同于数组的长度，那么其寻址的效率和不用没有任何不同。为了避免这样的情况，可以采用自平衡二叉查找树，例如红黑树、AVL树等等，通常这些自平衡二叉查找树都是为了限制树高而设计的。

二叉查找树也可以用来构建字典数据类型，对于小规模的查找其效率通常较散列表（哈希表）要高。本想写个用红黑树之类的构造字典的类的，同时可以说明为何在开始我将类归为一种特殊的数据类型，以后有时间再说吧。

树的种类还有很多，如B树、2-3树、2-3-4树等等，通常都是设计用来解决不同问题的。

dingboy_VBA

这个贴子要大力支持，因为我也写过涉及BOM的程序，总感觉不是甚理想。

dingboy_VBA

lee1892 发表于 2012-12-18 15:26
迭代（Iteration）与递归（Recursion）

在我们讲数据结构之前，先作一下思维训练。经常看到有人说什么递 ...

按作者的例子，迭代是变量在函数体内不断操作，递归是函数不断调用自身，两者差别比较大。

lee1892

也谈排序

论坛里常有关于各种排序法的讨论，从最基础的冒泡（Bubble Sort）、插入（Insertion Sort），到快速排序（Quick Sort）、希尔排序（Shell Sort）、堆排序（Heap Sort）等等。

我个人的看法是，讨论某种排序算法最快其实没什么意义，选择合适的算法才是我们应该考量的。

实际上，排序算法根据其特点可以分为如下几类：

交换排序：冒泡、快速 等
插入排序：插入、希尔、树排序 等
选择排序：堆排序 等
归并排序：归并排序（Merge Sort）等
分配排序：桶排序（Bucket Sort）、基数排序（Radix Sort）等
...

为论坛内所推崇的希尔排序、快速排序在很多时候并不是最佳的选择，比如一个整数数组、一个字符串数组、多关键字的二维数组等等。通常情况下，分配排序的时间效率会远远高于其他排序方法，但带来的往往是会消耗更多的空间（内存）。用空间换时间不仅仅是在战场上有用，同样适合于我们的计算机世界，呵呵。

下面这段代码测试了对一个正整数数组的排序速度，可以看到桶排序的方式完胜所有其他方法，而基数排序当把基数设置的偏大的时候（如对于10万内的数，使用1万作为基数）也有不错的表现，而基于比较后采用交换、插入的原地排序方法，则不可避免的会使用大量的循环。实际上由于这里的快速排序采用的是递归的方法，其使用的编译器生成的堆栈空间也是相当可观的。

另：下面的这个所谓桶排序，实际上是计数排序（Counting Sort）作为桶排序的特例演示，即使用待排序的数组的值作为桶数组的下标。

注：希尔排序的代码来自于 法师 的帖子 [原创] 有史以来最快的希尔排序 - 比历史贴快10倍，比Excel排序更快 - 兼论堆排序和快速排序

[code=vb]
Sub SpeedTest()
    Dim arr&(), aData, i&, nLen&, nMax&, t#
    nLen = 10 ^ 6: nMax = 10 ^ 5
    ReDim arr(1 To nLen)
    Randomize
    For i = 1 To nLen
        arr(i) = CLng(Rnd * nMax)
    Next
    aData = arr:    t = Timer
    Call RadixSort(aData)
    Debug.Print "基数排序用时：" & Round(Timer - t, 2) & " 秒"
    aData = arr:    t = Timer
    Call BucketSort(aData)
    Debug.Print "桶排序用时：" & Round(Timer - t, 2) & " 秒"
    aData = arr:    t = Timer
    Call ShellSort(aData, 1, nLen)
    Debug.Print "希尔排序用时：" & Round(Timer - t, 2) & " 秒"
    aData = arr:    t = Timer
    Call QuickSort(aData, 1, nLen)
    Debug.Print "快速排序用时：" & Round(Timer - t, 2) & " 秒"
End Sub
Sub BucketSort(aData)
    Dim i&, j&, aBucket&(), nMinNum&, nMaxNum&, n&
    nMinNum = aData(LBound(aData)): nMaxNum = nMinNum
    For i = LBound(aData) To UBound(aData)
        If aData(i) < nMinNum Then nMinNum = aData(i)
        If aData(i) > nMaxNum Then nMaxNum = aData(i)
    Next
    ReDim aBucket(nMinNum To nMaxNum)
    For i = LBound(aData) To UBound(aData)
        aBucket(aData(i)) = aBucket(aData(i)) + 1
    Next
    n = LBound(aData) - 1
    For i = nMinNum To nMaxNum
        If aBucket(i) > 0 Then
            For j = 1 To aBucket(i)
                n = n + 1
                aData(n) = i
            Next
        End If
    Next
End Sub
Sub RadixSort(aData)
    Dim i&, aBucket&(), arr, nMaxNum&, nExp&, k%, nLB&, nUB&, nRadix&
    nLB = LBound(aData): nUB = UBound(aData)
    For i = nLB To nUB
        If aData(i) > nMaxNum Then nMaxNum = aData(i)
    Next
    ReDim arr(nLB To nUB)
    nExp = 1: nRadix = 10000
    Do
        ReDim aBucket(0 To nRadix - 1)
        For i = nLB To nUB
            k = Int(aData(i) / nExp) Mod nRadix
            aBucket(k) = aBucket(k) + 1
        Next
        For i = 1 To nRadix - 1
            aBucket(i) = aBucket(i) + aBucket(i - 1)
        Next
        For i = nUB To nLB Step -1
            k = Int(aData(i) / nExp) Mod nRadix
            arr(aBucket(k) + nLB - 1) = aData(i)
            aBucket(k) = aBucket(k) - 1
        Next
        aData = arr
        nExp = nExp * nRadix
        If nMaxNum / nExp < 1 Then Exit Do
    Loop
End Sub

Sub ShellSort(ArrKey, L As Long, R As Long)
    Dim i As Long, j As Long, k As Long, h As Long, max_h As Long, offset As Long, one As Long
    Dim Insert, h_arr() As Long, temp_h, temp_h2
    temp_h = Array(1, 5, 19, 41, 109, 209, 505, 929, 2161, 3905, 8929, 16001, 36289, 64769, 146305, 260609, 587521, 1045055, 2354689, 4188161, 9427969)
    '此增量序列也是拥有 O(N^1.25)的阶，但是明显比 h(n+1) = 3 * h(n) + 1更高效
    temp_h2 = Array(1, 5, 19, 41, 109, 211, 503, 929, 2161, 3907, 8929, 16001, 36293, 64763, 146309, 260609, 587527, 1045055, 2354689, 4188161, 9427969)
   
    ReDim h_arr(LBound(temp_h2) To UBound(temp_h2))
    h_arr(LBound(h_arr)) = 1
    For i = LBound(h_arr) + 1 To UBound(h_arr)
    '    h_arr(i) = 2.25 * h_arr(i - 1) + 1   '此增量序列拥有 O(N^1.25)的阶，但是速度也略为不如上面的序列1,5,19,41
    '    h_arr(i) = 3 * h_arr(i - 1) + 1       '此增量序列拥有 O(N^1.25)的阶，但是速度明显不如上面的2.25序列
        h_arr(i) = temp_h2(i)
        If h_arr(i) < (R - L) / 9 Then max_h = i
    '    If h_arr(i) > 2 ^ 31 / 2.25 Then Exit For
    Next i
    If max_h < LBound(h_arr) Then max_h = LBound(h_arr)
   
    one = 1
    For i = max_h To LBound(h_arr) Step -one
        h = h_arr(i)
        For offset = 0 To h - 1
            For j = L + offset To R Step h
                Insert = ArrKey(j)
                For k = j - h To L + offset Step -h
                    If Insert < ArrKey(k) Then
                        ArrKey(k + h) = ArrKey(k)
                        ArrKey(k) = Insert
                    Else
                        Exit For
                    End If
                Next k
            Next j
        Next offset
    Next i
End Sub
Sub QuickSort(aData, nLeft&, nRight&)
    Dim i&, j&, gKey, gTemp
    If nLeft >= nRight Then Exit Sub
    gKey = aData(nLeft)
    i = nLeft + 1: j = nRight
    Do
        Do While i <= nRight
            If aData(i) > gKey Then Exit Do
            i = i + 1
        Loop
        Do While j > nLeft
            If aData(j) < gKey Then Exit Do
            j = j - 1
        Loop
        If i >= j Then Exit Do
        gTemp = aData(i): aData(i) = aData(j): aData(j) = gTemp
    Loop
    gTemp = aData(nLeft): aData(nLeft) = aData(j): aData(j) = gTemp
    Call QuickSort(aData, nLeft, j)
    Call QuickSort(aData, j + 1, nRight)
End Sub
[/code]

有机会再聊聊排序的那点事，看看是不是有更高效的多关键字的二维数组排序之类的。

Moneky

谢谢分享，期待楼主后继大作，楼主是个科班出身的吧？

lee1892

字典（Dictionary）和散列表（Hash Table）

字典，可以用一个变量或值（即键或关键字）转换为一个地址（即值），又称关联数组（Associative Array）。我个人的看法应该是一个数据类型，至于其背后隐藏的采用何种方式实现的则仍然是 数据结构+算法 的事情。我们知道，一个自平衡二叉查找树也可以用来构造字典，而对于关键字是整数的，则还可以直接使用数组来构造，当然更多的是采用散列表来构建的，或是几种方式的结合。

我们在VBA常用的字典对象，其关键字Key和值Item都可以是任何变量。我个人的猜测是对于关键字为数组、对象、自定义类型之类的，其传递的是一个内存地址，而可以直接使用数组来进行索引。同样对于值为上述变量的，其在内部的关联数组中保留的也是内存地址的链接，这也能解释为何在将某个字典对象实例 Set 为 Nothing 后其占用内存并未得到释放。

至于散列表则是一种通过散列函数将键名和键值关联起来的数据结构。值得一提的是，国内常有称之为哈希表的，这是误以为是个叫哈希的人发明的，实际上完全没这回事，呵呵。

如果我们将散列函数写为 f，那么对于散列表结构中存在的关键字 K，其对应的存储位置即在 f(K) 上。这样一来，不需要比较就可以直接取得查找记录。按照这个思想建立的表就称为散列表。这里，数据结构功能的实现依托于算法之上。

实现散列功能的算法也有很多种，如除留余数法（见法师的帖子：[原创] VBA字典的原理：哈希查找的示例程序，现在创造你自己的VBA字典吧!）、数字分析法、平方取中法等等。

散列表、散列算法应用十分广泛，加密解密、校验、字典等等。我们常用的文件的MD5校验就是一种散列算法。

最后，数据结构还包括图（Graph）、集合（Collection）等等概念，就不多说了。。。

写完这个帖子对我的基础知识的整理有很大帮助啊，也蛮不错~~