VBA进阶：基础扩展17. 链表

链表是一种基本的数据结构。在C语言中，由于具有指针特性，因此很容易实现链表结构。在节点中存储数据和指针，使用指针指向下一个元素的地址，形成链表，如下图1所示。

图1

在VBA中，使用类模块，也可以实现链表结构。下面，以实现顺序链表为例来讲解如何使用VBA代码创建链表。

在VBE中，先插入两个类模块：ListItem类模块和List类模块。其中，ListItem类模块用于存放链表节点中的数据和指向下一个元素的指针；List类模块用于实现链表节点的添加、删除、遍历等操作。

ListItem类模块

ListItem类模块包含节点的数据值和指向下一节点的指针：

代码语言：javascript复制

'节点元素值
Public Value As Variant
'指向下一个节点元素的指针
Public NextItem As ListItem

List类模块

List类模块中，声明了一个表示头节点的变量ListHead；包含3个方法：Add方法用来添加节点元素，Delete方向用来删除节点元素，ListAllItem方法遍历节点中所有元素；还有一个Find函数，用来查找值并确定是否将给定元素添加到相应位置或者是否删除给定元素。

首先，在模块开头声明表示头节点的变量：

代码语言：javascript复制

'头节点
Dim ListHead As ListItem

Find函数

代码语言：javascript复制

Function Find(ByVal varItem As Variant, _
    ByRef listCurrent AsListItem, _
    ByRef listPrevious AsListItem) As Boolean
    Dim bFound As Boolean
    '初始化当前节点为头节点
    bFound = False
    Set listPrevious =Nothing
    Set listCurrent =ListHead
    '链表不为空则循环
    Do While Not listCurrent Is Nothing
        '查找给定的值,如果当前值不是,则后移
        With listCurrent
            If varItem >.Value Then
                Set listPrevious = listCurrent
                Set listCurrent = .NextItem
            Else
                Exit Do
            End If
        End With
    Loop
    '如果找到,则返回True
    If Not listCurrent Is Nothing Then
        bFound =(listCurrent.Value = varItem)
    End If
    Find = bFound
End Function

假设要在已有链表中查找值5，下图2演示了Find函数的查找过程。

图2

Add方法

代码语言：javascript复制

'添加节点元素
Public Sub Add(varValue As Variant)
    Dim listNew As NewListItem
    Dim listCurrent AsListItem
    Dim listPrevious AsListItem
    '新元素值
    listNew.Value = varValue
    '调用Find函数确定新元素位置
    Call Find(varValue,listCurrent, listPrevious)
    '如果链表存在节点,则将新元素节点链接到相应位置
    If Not listPrevious Is Nothing Then
        Set listNew.NextItem= listPrevious.NextItem
        Set listPrevious.NextItem = listNew
    Else
    '链表不存在节点,则该元素为头节点
        Set listNew.NextItem= ListHead
        Set ListHead =listNew
    End If
End Sub

假设要在上图2所示的链表中添加节点元素6，Add方法调用Find函数查找链表中是否存在元素值为6的节点，若不存在，则返回要添加的节点元素的位置，然后链接该节点至链表中。图3演示了代码的运行过程。

图3

Delete方法

代码语言：javascript复制

'删除节点元素
Public Function Delete(varItem As Variant) As Boolean
    Dim listCurrent As ListItem
    Dim listPrevious As ListItem
    Dim bFound As Boolean
    '调用Find函数确定删除元素的位置
    bFound = Find(varItem,listCurrent, listPrevious)
    If bFound Then
        '删除中间的节点元素
        If Not listPrevious Is Nothing Then
            Set listPrevious.NextItem = listCurrent.NextItem
        Else
        '删除头节点元素
            Set ListHead =listCurrent.NextItem
        End If
    End If
    Delete = bFound
End Function

Delete方法与Add方法类似，在调用Find函数找到要删除元素的位置后，通过节点指针将删除元素从链表中脱离。

ListAllItem方法

代码语言：javascript复制

'遍历链表
Public Sub ListAllItem()
    Dim listCurrent AsListItem
    Set listCurrent =ListHead
    '从头节点开始遍历
    Do While Not listCurrent Is Nothing
        Debug.Print listCurrent.Value
        Set listCurrent =listCurrent.NextItem
    Loop
End Sub

ListAllItem方法从头节点开始遍历链表，在立即窗口打印每个节点元素值。

测试链表

下面的代码先使用Add方法创建链表，然后再使用Add方法在已有链表中添加元素节点，最后使用Delete方法删除指定节点。

代码语言：javascript复制

Sub TestList()
    Dim listTest As New List
    With listTest
        .Add 1
        .Add 3
        .Add 5
        .Add 7
        Call .ListAllItem
        Debug.Print "-----------"
        .Add 6
        Call .ListAllItem
        Debug.Print "-----------"
        .Delete 3
        .Delete 7
        Call .ListAllItem
    End With
End Sub

代码运行结果如下图4所示。

图4

下面是List类模块代码的图片版：

编程算法 vba

0 人点赞