Home » VBA Excel » VBA Excel Stack trong Excel VBA

VBA Excel Stack trong Excel VBA

viết bởi Lê Quốc Thái

Stack là một thư viện nằm trong “System.Collections” của .NET Framework. Cho phép lưu trữ dữ liệu (items) có kích cỡ lớn, rất hữu ích trong các tình huống khi cần xử lý trước nhất những items mà truyền vào Stack sau cùng.
Đây là cấu trúc dữ liệu dựng theo ngăn xếp để thực hiện tích chất LIFO (last in first out).

Yêu cầu: Hệ thống phải cài đặt .NET Framework

1. Khai báo Stack

1.1. Kiểu khai báo sớm


(Không có Tooltip khi gọi Stack, phải thiết lập trong Tools/References)
– Trong cửa sổ VBA, Tools menu, References.
– Tìm và check vào mục “mscorlib.dll” trong cửa sổ References – VBAProject.
Khai báo trong code:

Dim oStack As New Stack

1.2. Kiểu khai báo muộn


(Không có Tooltip khi gọi Stack, không cần thiết lập trong Tools/References).
Khai báo trong code: 

Dim oStack As Object
Set oStack = CreateObject("System.Collections.Stack")


2. Các phương thức, thuộc tính


2.1. Push
oStack.Push Item


Thêm một Item vào vị trí trên cùng (top) của Stack.
Item nhận kiểu dữ liệu bất kỳ (kiểu số hoặc chuỗi), giá trị đơn hoặc một mảng (array).
Ví dụ:

Sub PushMethod()
    'Dim oStack As New Stack'
    Dim oStack As Object
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.Push Item'
    oStack.Push 5
    oStack.Push "TextA"
    oStack.Push ""
End Sub

2.2. Count
oStack.Count


Trả về số Items có trong Stack.
Ví dụ:

Sub CountProperty()
    Dim oStack As Object
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.Count'
    oStack.Push 5
    oStack.Push "TextA"
    MsgBox oStack.Count '2'
End Sub

2.3. Peek
oStack.Peek


Trả về Item trên cùng của Stack và không xóa Item đó.
Ví dụ:

Sub PeekMethod()
    Dim oStack As Object, i As Long
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.Peek'
    For i = 1 To 10
        oStack.Push "Value-" & i
    Next i
    MsgBox oStack.Peek  'Value-10'
End Sub

2.4. Pop
oStack.Pop


Xóa và trả về Item trên cùng của Stack.
Ví dụ:

Sub PopMethod()
    Dim oStack As Object, i As Long, sValue As String
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.Pop'
    For i = 1 To 10
        oStack.Push "Value-" & i
    Next i
    sValue = oStack.Pop
    MsgBox sValue       'Value-10'
    MsgBox oStack.Count '9'
End Sub

2.5. Contains
oStack.Contains


Kiểm tra sự tồn tại của một Item trong Stack. Trả về True nếu Item đó tồn tại, ngược lại trả về False.
Ví dụ:

Sub ContainsMethod()
    Dim oStack As Object
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.Contains'
    oStack.Push 5
    oStack.Push "TextA"
    MsgBox oStack.Contains(5)       'True'
    MsgBox oStack.Contains("TextA") 'True'
    MsgBox oStack.Contains("TextB") 'False
End Sub

2.6. ToArray
oStack.ToArray


Sao chép các Item trong Stack vào một mảng (Array). Mảng trả về là mảng một chiều, chỉ số cận dưới của mảng luôn bằng 0, cho dù thiết lập Option Base 1.
Ví dụ:

Sub ToArrayMethod()
    Dim oStack As Object, i As Long, arr()
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.ToArray     Mang 1 chieu,cac phan tu trong mang xep nguoc, khong phu thuoc Option Base 1'
    For i = 1 To 10
        oStack.Push i
    Next i
    arr = oStack.ToArray
    MsgBox arr(0)   '10'
End Sub

2.7. Clear
oStack.Clear


Xóa tất cả các Items có trong Stack.
Ví dụ:

Sub ClearMethod()
    Dim oStack As Object, i As Long
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.Clear'
    For i = 1 To 10
        oStack.Push i
    Next i
    oStack.Clear
    MsgBox oStack.Count '0'
End Sub

2.8. Clone
oStack.Clone


Sao chép toàn bộ Stack đã dựng sang một Stack mới.
Ví dụ:

 Sub CloneMethod()
    Dim oStack As Object, newStack As Object
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.Clone'
    oStack.push 20
    Set newStack = oStack.Clone
    MsgBox newStack.Peek    '20'
End Sub

2.9. ToString
oStack.ToString


Trả về tên đối tượng hiện hành, tức là “System.Collections.Stack”.
Ví dụ:

Sub ToStringMethod()
    Dim oStack As Object, sName As String
    Set oStack = CreateObject("System.Collections.Stack")
    'oStack.ToString'
    sName = oStack.ToString
    MsgBox sName    'System.Collections.Stack'
End Sub

2.10. GetHashCode 
oStack.GetHashCode




3. Ứng dụng


– Lọc loại trùng
– …

3.1. Hàm lọc loại trùng trong một cột

'// Loc loai trung mot cot
Public Function UniqueColumnStack(ByVal Rng As Range) As Variant
    If Rng.Count = 1 Then UniqueColumnStack = Rng.Value: Exit Function
    Dim HTbl As Object, i As Long, j As Long, arr(), Result(), sKey As Variant
    Set HTbl = CreateObject("System.Collections.Stack")
    arr = Rng.Value
    For i = LBound(arr, 1) To UBound(arr, 1)
        sKey = arr(i, 1)
        If sKey <> "" Then
            If HTbl.Containskey(sKey) = False Then
                HTbl.Add sKey, ""
                j = j + 1
                ReDim Preserve Result(1 To j)
                Result(j) = sKey
            End If
        End If
    Next i
    UniqueColumnStack = Result
End Function

3.2. Hàm truyền các Items của Stack sang mảng 2 chiều
'// Truyen cac Items cua Stack sang mang 2 chieu'
Public Function StackToArray2D(oStack As Object, Optional ByVal Reverse As Boolean = False) As Variant
    Dim iCount As Long
    iCount = oStack.Count
    If iCount = 0 Then Exit Function
    Dim Result(), i As Long, j As Long, arr()
    ReDim Result(1 To iCount, 1 To 1)
    arr = oStack.ToArray
    If Reverse = False Then
        For i = LBound(arr) To UBound(arr) Step 1
            j = j + 1
            Result(j, 1) = arr(i)
        Next i
    Else
        For i = UBound(arr) To LBound(arr) Step -1
            j = j + 1
            Result(j, 1) = arr(i)
        Next i
    End If
    StackToArray2D = Result
End Function

3.3. Ví dụ so sánh tốc độ Add Keys với kiểu dữ liệu là kiểu số:

Stack:
Sub AddKeys_Stack()
    Dim TT As Double
    TT = Timer
    Dim oStack As Object
    Set oStack = CreateObject("System.Collections.Stack")
    Dim x As Long, y As Long, i As Long
    x = 1000000000
    y = 1000020000
    For i = x To y
        If oStack.Contains(i) = False Then
            oStack.push i
        End If
    Next i
    Set oStack = Nothing
    MsgBox Round(Timer - TT, 2) '1.64-1.78 giây'
End Sub


Hashtable:

Sub AddKeys_Hashtable()
    Dim TT As Double
    TT = Timer
    Dim HTbl As Object
    Set HTbl = CreateObject("System.Collections.Hashtable")
    Dim x As Long, y As Long, i As Long
    x = 1000000000
    y = 1000020000
    For i = x To y
        If HTbl.Containskey(i) = False Then
            HTbl.Add i, ""
        End If
    Next i
    Set HTbl = Nothing
    MsgBox Round(Timer - TT, 2) '0.19-0.20 giây'
End Sub


Dictionary:

Sub AddKeys_Dictionary()
    Dim TT As Double
    TT = Timer
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dim x As Long, y As Long, i As Long
    x = 1000000000
    y = 1000020000
    For i = x To y
        If Dic.Exists(i) = False Then
            Dic.Add i, ""
        End If
    Next i
    Set Dic = Nothing
    MsgBox Round(Timer - TT, 2) '5.96-6.09 giây'
End Sub

Tải file ví dụ: Stack

Bài viết liên quan

Viết ý kiến của bạn