VBA 的一个非常基础的单链表

• 下载源代码 - 35.9 KB

引言

链表以多种不同的方式使用，以动态地存储和检索数据，并按逻辑顺序存储，而不是根据物理顺序存储数据。在某些情况下，链表可能非常有用，但如果基本语言不直接支持某些数据类型，则构建链表会非常令人沮丧。这是一个用 VBA 和 Excel 2016 编写的基于节点的链表的快速版本（适用于那些被限制使用脚本语言的人）。

背景

这更像是编程的“如何”，而不是“为什么”。“为什么”应该留给聊天室等。VBA 不直接支持指针，同时也会通过指针传递所有数据到函数、子程序、属性等，除非使用关键字 ByVal 另行指定。使用 ByRef 或省略在传递变量中的关键字是在通过指针传递。然而，VBA 并没有提供对所述指针的轻松访问。虽然有一些方法 (LongPTR 和 memcopy) 可以将引用指针视为一个长整型并更改变量或指针，但这对于链表和 VBA 的问题来说是一个更高级的答案，我不想花太多时间。这个答案是基本的，并使用一个节点类型的类，并附有简单的对话框。

Using the Code

此代码中包含三个类和一个测试模块。请记住将每个类的名称与它出现的名称完全相同，否则将无法编译。请下载示例以查看测试模块如何充分利用 LinkedList_CLS 的所有元素。

如何在 Test_Module 中声明类

'''''''''''''''''''' Test_Module ''''''''''''''''''''''''''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Testing module for node and linked list '''''''''''''
Option Explicit

' testing sub
Sub Test()
    ' turn features off
    Dim oHelper As Helper: Set oHelper = New Helper
    ' basic error catching (nothing fancy here)
    On Error GoTo Err
    ' declare new linked list
    Dim oLinkedList As LinkedList_CLS: Set oLinkedList = New LinkedList_CLS
    ' determine if running or not
    Dim running As Boolean: running = True
    ' set workbook and worksheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Sheets("OutPut")
    ' local variables
    Dim intIn As Integer: Dim answerIn As Variant

这是一个简单的 Helper 类，可以加快速度

'''''''''''''''''''' Helper '''''''''''''''''''''''''''' ''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Class turn off and on features ''''''''''''''''''''''
Option Explicit

' turn off features when class is created
Private Sub Class_Initialize()
    Application.Calculation = xlCalculationManual
    'Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

' turn on features when class is destroyed
Private Sub Class_Terminate()
    Application.Calculation = xlCalculationAutomatic
    'Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

这是 Node_CLS 类，其中包含数据和指向下一个节点的指针

'''''''''''''''''''' Node_CLS '''''''''''''''''''''''''''''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Class to hold node data and pointers ''''''''''''''''
Option Explicit

''''''''''''''''''' Public access variables '''''''''''''''''''''''''''''
Public data As Integer
Public nextNode As Node_CLS

这是按每个子程序、函数或属性细分的 LinkedList_CLS

'''''''''''''''''''' LinkedList_CLS '''''''''''''''''''''''''''''''''''''
' by Samuel J Bowlin                                                    '
' 3/10/2019                                                             '
' Version 1.0.0                                                         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''' Class to manipulate Node_CLS ''''''''''''''''''''''''
Option Explicit

'''''''''''''''''''' Private variables to use in this class '''''''''''''
Private head As Node_CLS

'''''''''''''''''''' Public properties ''''''''''''''''''''''''''''''''''

' add data to front of the list non-recursively
Public Property Let push(pushData As Integer)
    Dim pushNode As Node_CLS: Set pushNode = New Node_CLS
    pushNode.data = pushData
    Set pushNode.nextNode = head
    Set head = pushNode
End Property

' add data to back of list non-recursively
Public Property Let append(appendData As Integer)
    Dim appendNode As Node_CLS: Set appendNode = New Node_CLS
    appendNode.data = appendData
    If head Is Nothing Then
        Set head = appendNode
        Exit Property
    Else
        Dim last As Node_CLS: Set last = head
        Do Until last.nextNode Is Nothing
            Set last = last.nextNode
        Loop
        Set last.nextNode = appendNode
     End If
End Property

' get length of list as integer non-recursively
Public Property Get getLength() As Integer
    getLength = get_Length(head)
End Property

' remove data from list non-recursively
Public Property Let remove(removeData As Integer)
    Dim removeNode As Node_CLS: Set removeNode = head
    Dim prevNode As Node_CLS
    Do Until removeNode Is Nothing
        If removeNode.data = removeData Then
            If removeNode Is head Then
                Set head = removeNode.nextNode
            Else
                Set prevNode.nextNode = removeNode.nextNode
            End If
            Exit Property
        End If
        Set prevNode = removeNode
        Set removeNode = removeNode.nextNode
    Loop
End Property

' check if data exists in list non-recursively
Public Property Get exists(dataExists As Integer) As Boolean
    Dim existsNode As Node_CLS: Set existsNode = head
    Do Until existsNode Is Nothing
        If existsNode.data = dataExists Then
            exists = True
            Exit Property
        End If
        Set existsNode = existsNode.nextNode
    Loop
End Property

' get position of data in list (0 through ?) non-recursively
Public Property Get pos(dataPos As Integer) As Integer
    If Not exists(dataPos) Then: pos = -1: Exit Property
    Dim posNode As Node_CLS: Set posNode = head
    Do Until posNode Is Nothing
        If posNode.data = dataPos Then
            Exit Property
        Else
            Set posNode = posNode.nextNode
            pos = pos + 1
        End If
    Loop
End Property

' see if list is empty
Public Property Get isEmpty() As Boolean
    If head Is Nothing Then
        isEmpty = True
    End If
End Property

' get node data at nth position from front non-recursively
Public Property Get getNth(nth As Integer) As Integer
    Dim nthNode As Node_CLS: Set nthNode = head
    Dim nthCount As Integer
    Do Until nthNode Is Nothing
        If nthCount + 1 = nth Then
            getNth = nthNode.data: Exit Property
        Else
            nthCount = nthCount + 1: Set nthNode = nthNode.nextNode
        End If
    Loop
    getNth = -1
End Property

' get nth node data from last non-recursively
Public Property Get getNthFromLast(nthFromLast As Integer) As Integer
    Dim nthCount As Integer: nthCount = get_Length(head)
    Dim nthNode As Node_CLS: Set nthNode = head
    Dim i As Integer
    If nthCount >= nthFromLast Then
        For i = 0 To nthCount - nthFromLast - 1
            Set nthNode = nthNode.nextNode
        Next i
        getNthFromLast = nthNode.data: Exit Property
    End If
    getNthFromLast = -1
End Property

' get middle data of list non-recursively
Public Property Get middle() As Integer
    If Not isEmpty() And Not head.nextNode Is Nothing Then
        Dim mid As Integer: mid = (get_Length(head) / 2)
        Dim midNode As Node_CLS: Set midNode = head
        Do Until mid - 1 = 0
            Set midNode = midNode.nextNode
            mid = mid - 1
        Loop
        middle = midNode.data: Exit Property
    End If
    middle = -1
End Property
' get number of times a var appears in list
Public Property Get countTotal(dataCount As Integer) As Integer
    Dim countNode As Node_CLS: Set countNode = head
    Do Until countNode Is Nothing
        If dataCount = countNode.data Then
            countTotal = countTotal + 1
        End If
        Set countNode = countNode.nextNode
    Loop
End Property
' print out node data non-recursively
Public Property Let printNodes(MyWS As Worksheet)
    MyWS.Range("F:F").ClearContents
    Dim rowCounter As Integer: rowCounter = 1
    Dim nodeToPrint As Node_CLS: Set nodeToPrint = head
    Do Until nodeToPrint Is Nothing
        MyWS.Cells(rowCounter, 6).Value = nodeToPrint.data
        rowCounter = rowCounter + 1
        Set nodeToPrint = nodeToPrint.nextNode
    Loop
End Property

'''''''''''''''''''' Public subs ''''''''''''''''''''''''''''''''''''''''

' merge sort the list recursively
Public Sub mergeSort()
    If isEmpty Then: Exit Sub
    If head.nextNode Is Nothing Then: Exit Sub
    Set head = merge(head)
End Sub

' delete the list non-recursively
Public Sub deleteList()
    Do Until head Is Nothing
        Set head = head.nextNode
    Loop
    Set head = Nothing
End Sub

'''''''''''''''''''' Private properties '''''''''''''''''''''''''''''''''

' merge sort the list (Property Get mergeSort)
Private Property Get merge(mergeNode As Node_CLS) As Node_CLS
    Dim oldHead As Node_CLS: Set oldHead = mergeNode
    Dim mid As Integer: mid = (get_Length(mergeNode) / 2) - 1
    If mergeNode.nextNode Is Nothing Then: Set merge = mergeNode: Exit Property
    Do Until mid = 0
        Set oldHead = oldHead.nextNode
        mid = mid - 1
    Loop
    Dim newHead As Node_CLS: Set newHead = oldHead.nextNode
    Set oldHead.nextNode = Nothing
    Set oldHead = mergeNode
    Dim front As Node_CLS: Set front = merge(oldHead)
    Dim back As Node_CLS: Set back = merge(newHead)
    Set merge = mergeList(front, back)
End Property

' merged two list for merge sort (Property Get merge)
Private Property Get mergeList(a As Node_CLS, b As Node_CLS) As Node_CLS
    Dim resultNode As Node_CLS
    If a Is Nothing Then: Set mergeList = b: Exit Property
    If b Is Nothing Then: Set mergeList = a: Exit Property
    If a.data > b.data Then
        Set resultNode = b
        Set resultNode.nextNode = mergeList(a, b.nextNode)
    Else
        Set resultNode = a
        Set resultNode.nextNode = mergeList(a.nextNode, b)
    End If
    Set mergeList = resultNode
End Property

' get length of given list (Property Get getLength)
Private Property Get get_Length(getLengthNode As Node_CLS) As Integer
    Dim lengthNode As Node_CLS: Set lengthNode = getLengthNode
    Do Until lengthNode Is Nothing
        Set lengthNode = lengthNode.nextNode
        get_Length = get_Length + 1
    Loop
End Property

'''''''''''''''''''' Private subs '''''''''''''''''''''''''''''''''''''''

' initialize the class
Private Sub Class_Initialize()

End Sub

' destroy the class
Private Sub Class_Terminate()
    Set head = Nothing
End Sub

关注点

销毁大型列表（例如 10,000 个或更多元素）已被证明是耗时且有时是有问题的。VBA 并不那么容易管理堆栈。但是，较小的列表似乎运行良好，没有我发现的任何错误。

历史

• 2019年3月10日：1^st草稿 - Excel 2016 上的 1.0.0 版稳定版