VBA Excel Stack trong Excel VBA

By Lê Quốc Thái

26/06/2019

4

365

Đánh giá lequocthai.com:

Voted: 0 Votes: 0

Your page rank:

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

Tags
Vba excel

Bài trước

VBA Excel Hashtable trong Excel VBA

Bài tiếp theo

VBA Excel Queue trong Excel VBA

BÀI VIẾT LIÊN QUAN

4 BÌNH LUẬN

BÌNH LUẬN Hủy trả lời

Vui lòng nhập bình luận của bạn

Vui lòng nhập tên của bạn ở đây

Bạn đã nhập một địa chỉ email không chính xác!

Vui lòng nhập địa chỉ email của bạn ở đây

Captcha verification failed!

CAPTCHA user score failed. Please contact us!