27.8 C
Ho Chi Minh City
Saturday, June 7, 2025
AIPHOGPT.COM
Trang chủ Blog Trang 198

VBA Excel Queue trong Excel VBA

Lê Quốc Thái
-
1
VBA Excel Queue trong Excel VBA
  1. Loạt các bài viết có liên quan chuyên đề VBA:
  2. VBA Excel Hộp thoại thông báo
  3. VBA Excel Biến trong VBA Excel
  4. VBA Excel sử dụng Scripting Dictionary
  5. VBA Excel Biến trong VBA Excel
  6. VBA Excel Workbook, worksheet
  7. VBA Excel Range, Cells
  8. VBA Excel Hàm trong Excel VBA
  9. VBA Excel Events, Application Object
  10. VBA Excel Function and Sub Excel VBA
  11. VBA Excel Array Mảng trong Excel VBA
  12. VBA Excel FileSystemObject trong Excel VBA
  13. VBA Excel Collection trong Excel VBA
  14. VBA Excel Hashtable trong Excel VBA
  15. VBA Excel Stack trong Excel VBA
  16. VBA Excel Queue trong Excel VBA
  17. VBA Excel SortedList Excel VBA
  18. VBA Excel ArrayList Excel VBA
  19. VBA Excel Ví dụ về Scripting Dictionary
  20. Sách VBA Excel 2016 power programming with vba (pdf)

Queue là một thư viện nằm trong “System.Collections.” của .NET Framework. cùng.
Đây là cấu trúc dữ liệu dựng theo hàng để thực hiện tính chất FIFO (First In – First Out / Vào trước – Ra trước).
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 muốn lưu trữ các Items theo thứ tự chỉ định.

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

1. Khai báo Queue

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


(Không có Tooltip khi gọi Queue, 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 oQueue As New Queue

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

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

Dim oQueue As Object
Set oQueue = CreateObject("System.Collections.Queue")


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

2.1. Count Property

oQueue.Count


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

Sub CountProperty()
    Dim oQueue As Object
    Set oQueue = CreateObject("System.Collections.Queue")
    'oQueue.Count'
    oQueue.Enqueue 5
    oQueue.Enqueue "TextA"
    MsgBox oQueue.Count   '2'
End Sub

2.2. Enqueue
oQueue.Enqueue Item


Thêm một Item vào vị trí cuối cùng (end) của Queue.
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 EnqueueMethod()
    Dim oQueue As Object
    Set oQueue = CreateObject("System.Collections.Queue")
    'oQueue.Enqueue Item'
    oQueue.Enqueue 5
    oQueue.Enqueue "TextA"
    oQueue.Enqueue ""
    oQueue.Enqueue Array(20, 40)
End Sub

2.3. Peek

oQueue.Peek
Trả về Item đầu tiên của Queue và không xóa Item đó.


Ví dụ:

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

2.4. Dequeue
oQueue.Dequeue


Xóa và trả về Item đầu tiên của Queue.
Ví dụ:

Sub DequeueMethod()
    Dim oQueue As Object, i As Long, sValue As String
    Set oQueue = CreateObject("System.Collections.Queue")
    'oQueue.Dequeue'
    For i = 1 To 10
        oQueue.Enqueue "Value-" & i
    Next i
    sValue = oQueue.Dequeue
    MsgBox sValue       'Value-1'
    MsgBox oQueue.Count '9'
End Sub

2.5. Contains
oQueue.Contains


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

Sub ContainsMethod()
    Dim oQueue As Object
    Set oQueue = CreateObject("System.Collections.Queue")
    'oQueue.Contains'
    oQueue.Enqueue 5
    oQueue.Enqueue "TextA"
    MsgBox oQueue.Contains(5)       'True'
    MsgBox oQueue.Contains("TextA") 'True'
    MsgBox oQueue.Contains("TextB") 'False
End Sub

2.6. ToArray
oQueue.ToArray


Sao chép các Item trong Queue 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 oQueue As Object, i As Long, arr()
    Set oQueue = CreateObject("System.Collections.Queue")
    'oQueue.ToArray     Mang 1 chieu, khong phu thuoc Option Base 1'
    For i = 1 To 10
        oQueue.Enqueue "Value-" & i
    Next i
    arr = oQueue.ToArray
    MsgBox arr(0)   'Value-1'
End Sub

2.7. ToString
oQueue.ToString


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

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

2.8. Clear
oQueue.Clear


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

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

2.9. Clone
oQueue.Clone


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

Sub CloneMethod()
    Dim oQueue As Object, newQueue As Object
    Set oQueue = CreateObject("System.Collections.Queue")
    'oQueue.Clone'
    oQueue.Enqueue 20
    Set newQueue = oQueue.Clone
    MsgBox newQueue.Peek    '20'
End Sub


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 UniqueColumnQueue(ByVal Rng As Range) As Variant
    If Rng.Count = 1 Then UniqueColumnQueue = Rng.Value: Exit Function
    Dim oQueue As Object, i As Long, j As Long, arr(), Result(), sKey As Variant
    Set oQueue = CreateObject("System.Collections.Queue")
    arr = Rng.Value
    For i = LBound(arr, 1) To UBound(arr, 1)
        sKey = arr(i, 1)
        If sKey <> "" Then
            If oQueue.Contains(sKey) = False Then
                oQueue.Enqueue sKey
                j = j + 1
                ReDim Preserve Result(1 To j)
                Result(j) = sKey
            End If
        End If
    Next i
    UniqueColumnQueue = Result
End Function

Tải file ví dụ: Queue

VBA Excel Stack trong Excel VBA

Lê Quốc Thái
-
4
VBA Excel Stack trong Excel VBA

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

VBA Excel Hashtable trong Excel VBA

Lê Quốc Thái
-
0
VBA Excel Hashtable trong Excel VBA

Hashtable là một thư viện nằm trong “System.Collections” của .NET Framework. Cho phép lưu trữ dữ liệu ở dạng mảng với Key riêng duy nhất, cho phép chèn và tìm kiếm đối tượng (Item) rất nhanh, kể cả với dữ liệu có kích cỡ lớn.

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


1. Khai báo Hashtable

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


(Không có Tooltip khi gọi Hashtable, 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 HTbl As New Hashtable

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


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

Dim HTbl As Object
Set HTbl = CreateObject("System.Collections.Hashtable")


2. Các phương thức (có 5 phương thức)

2.1. Add

HTbl.Add Key, Item


Thêm một Item vào Hashtable.
Key: Bắt buộc. Key nhận kiểu dữ liệu là số hoặc chuỗi bất kỳ. Yêu cầu Key phải duy nhất trong Hashtable, nếu Key đó đã tồn tại thì xảy ra lỗi.
Item: Bắt buộc. Item nhận kiểu dữ liệu là số hoặc chuỗi bất kỳ, giá trị đơn hoặc một mảng (array).

Ví dụ:

Sub AddMethod()
    Dim HTbl As Object
    Set HTbl = CreateObject("System.Collections.Hashtable")
    'HTbl.Add Key, Item'
    'Key: number + string, Duy nhat. Gap loi khi Key da ton tai trong HTbl'
    'Item: number + string'
    HTbl.Add 10, 100
    HTbl.Add "KeyA", 200
    HTbl.Add "KeyB", "TextB"
    HTbl.Add 20, 5
    HTbl.Add "KeyC", ""
    HTbl.Add "KeyD", Array(20, 25)
End Sub

2.2. Count
HTbl.Count


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

Sub CountMethod()
    Dim HTbl As Object
    Set HTbl = CreateObject("System.Collections.Hashtable")
    'HTbl.Count'
    Dim i As Long
    For i = 1 To 10
        HTbl.Add "Key" & i, i
    Next i
    MsgBox HTbl.Count '10'
End Sub

2.3. Item
HTbl.Item (Key)
'Hoặc:'
HTbl(Key)


Gọi tới Item của Hashtable theo Key chỉ định.
Nếu Key chỉ định đưa vào chưa tồn tại trong Hashtable thì không xảy ra lỗi và kết quả trả về là rỗng.
Ví dụ:

Sub ItemMethod()
    Dim HTbl As Object
    Set HTbl = CreateObject("System.Collections.Hashtable")
    'HTbl.Item(Key)'
    'HTbl(Key)'
    HTbl.Add 10, 100
    HTbl.Add "KeyA", 200
    HTbl("KeyA") = 500
    MsgBox HTbl.Item(10)        '100'
    MsgBox HTbl.Item("KeyA")    '500'
End Sub

2.4. Remove
HTbl.Remove(Key)


Xóa một Item trong Hashtable theo Key chỉ định ứng với Item đó.
Ví dụ:

Sub RemoveMethod()
    Dim HTbl As Object
    Set HTbl = CreateObject("System.Collections.Hashtable")
    'HTbl.Remove(Key)'
    Dim i As Long
    For i = 1 To 10
        HTbl.Add "Key" & i, i
    Next i
    HTbl.Remove ("Key4")
    MsgBox HTbl.Count   '9'
End Sub

2.5. ContainsKey
HTbl.ContainsKey(Key)


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

Sub ContainsKeyMethod()
    Dim HTbl As Object
    Set HTbl = CreateObject("System.Collections.Hashtable")
    'HTbl.ContainsKey(Key)'
    HTbl.Add 10, 100
    HTbl.Add "KeyA", 200
    MsgBox HTbl.Containskey(10)     'True'
    MsgBox HTbl.Containskey("KeyA") 'True'
    MsgBox HTbl.Containskey("KeyX") 'False'
End Sub


2.6. ContainsValue

HTbl.ContainsValue(Value)


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

Sub ContainsValueMethod()
    Dim HTbl As Object
    Set HTbl = CreateObject("System.Collections.Hashtable")
    'HTbl.ContainsValue(Value)'
    HTbl.Add 10, 100
    HTbl.Add "KeyA", "TextA"
    MsgBox HTbl.ContainsValue(100)     'True'
    MsgBox HTbl.ContainsValue("TextA") 'True'
    MsgBox HTbl.ContainsValue("TextB") 'False'
End Sub


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 UniqueColumnHashtable(ByVal Rng As Range) As Variant
    If Rng.Count = 1 Then UniqueColumnHashtable = Rng.Value: Exit Function
    Dim HTbl As Object, i As Long, j As Long, arr(), Result(), sKey As Variant
    Set HTbl = CreateObject("System.Collections.Hashtable")
    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
    UniqueColumnHashtable = Result
End Function

 

Tải file ví dụ: Hashtable

VBA Excel Collection trong Excel VBA

Lê Quốc Thái
-
3
VBA Excel Collection trong Excel VBA
  1. Loạt các bài viết có liên quan chuyên đề VBA:
  2. VBA Excel Hộp thoại thông báo
  3. VBA Excel Biến trong VBA Excel
  4. VBA Excel sử dụng Scripting Dictionary
  5. VBA Excel Biến trong VBA Excel
  6. VBA Excel Workbook, worksheet
  7. VBA Excel Range, Cells
  8. VBA Excel Hàm trong Excel VBA
  9. VBA Excel Events, Application Object
  10. VBA Excel Function and Sub Excel VBA
  11. VBA Excel Array Mảng trong Excel VBA
  12. VBA Excel FileSystemObject trong Excel VBA
  13. VBA Excel Collection trong Excel VBA
  14. VBA Excel Hashtable trong Excel VBA
  15. VBA Excel Stack trong Excel VBA
  16. VBA Excel Queue trong Excel VBA
  17. VBA Excel SortedList Excel VBA
  18. VBA Excel ArrayList Excel VBA
  19. VBA Excel Ví dụ về Scripting Dictionary
  20. Sách VBA Excel 2016 power programming with vba (pdf)

Collection trong VBA là một cấu trúc dữ liệu đơn giản có sẵn trong VBA để lưu trữ các đối tượng. Các collections trong VBA linh hoạt hơn so với Array trong VBA vì chúng không giới hạn ở kích cỡ của chúng vào bất kỳ thời điểm nào và không yêu cầu phải dò lại kích thước bằng tay. 
Collection rất hữu dụng khi ta không muốn sử dụng các cấu trúc dữ liệu phức tạp hơn (nhưng khá tương tự) như ArrayList hay Dictionary.

1. Khai báo Collection

Dim myCol As Collection
Set myCol = New Collection

2. Các phương thức (có 4 phương thức)

2.1. Add

myCol.Add (Item, [Key], [Before], [After])

Thêm một Item vào collection.
Item: Bắt buộc. Item nhận kiểu dữ liệu là số hoặc chuỗi bất kỳ, giá trị đơn hoặc một mảng (array).
Key: Không bắt buộc. Nếu có nhập Key thì yêu cầu Key đó chưa tồn tại trong collection, Key chỉ nhận giá trị kiểu chuỗi.
Before: Không bắt buộc. Chỉ định vị trí của Item thêm vào trước một Item đã có trong collection (theo chỉ số của Item đó).
After: Không bắt buộc. Chỉ định vị trí của Item thêm vào đứng sau một Item đã có trong collection (theo chỉ số của Item đó).
Ví dụ:

Sub AddMethod()
    Dim myCol As Collection
    Set myCol = New Collection
    'mycol.Add (Item, [Key], [Before], [After]) '
    myCol.Add 2                 'Item: 2    '
    myCol.Add "B"               'Item: 2, "B"   '
    myCol.Add "C", key:="KeyC"  'Items: 2, "B", "C" '
    myCol.Add "A", "KeyA", before:=2    'Items: 2, "A","B","C"  '
    myCol.Add 1, , After:=4             'Items: 2, "A","B","C",1    '
    myCol.Add Array(5, 20)              'Items: 2, "A","B","C",1, array(5,20)'
End Sub

2.2. Count

myCol.Count

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

Sub CountMethod()
    Dim myCol As Collection, i As Long
    Set myCol = New Collection
    For i = 1 To 10
        myCol.Add i
    Next i
    MsgBox myCol.Count
End Sub

2.3. Item

myCol.Item (Index)
'Hoặc:
myCol(Index)
'Hoặc:
myCol(Key)

Gọi tới Item của collection theo chỉ số của Item hoặc theo Key ứng với Item đó.
Ví dụ:

Sub ItemMethod()
    Dim myCol As Collection
    Set myCol = New Collection
    myCol.Add "A", "KeyA"
    MsgBox myCol.Item(1)
    MsgBox myCol(1)
    MsgBox myCol("KeyA")
End Sub

2.4. Remove

mycol.Remove(Index)
'Hoặc
mycol.Remove(Key)

Xóa một Item trong collection theo chỉ số của Item hoặc Key ứng với Item đó.
Ví dụ:

Sub Remove()
    Dim myCol As Collection
    Set myCol = New Collection
    myCol.Add "A", "KeyA"
    myCol.Add 10, "2"
    myCol.Add 20, "Key3"
    myCol.Remove (2)
    myCol.Remove ("Key3")
    MsgBox myCol.Count
End Sub

3. Ứng dụng

– Lọc loại trùng
– Sắp xếp dữ liệu

'// Kiem tra su ton tai cua mot key trong Collection'
Public Function KeyExists(myCol As Collection, ByVal keyCheck As String) As Boolean
    KeyExists = False
    On Error GoTo EndFunction
    myCol.Item keyCheck
    KeyExists = True
EndFunction:
End Function

'// Loc loai trung mot cot'
Public Function UniqueColumnCollection(ByVal Rng As Range) As Variant
    If Rng.Count = 1 Then UniqueColumnCollection = Rng.Value: Exit Function
    Dim myCol As Collection, i As Long, j As Long, arr(), Result(), sKey As Variant
    Set myCol = New Collection
    arr = Rng.Value
    For i = LBound(arr, 1) To UBound(arr, 1)
        sKey = arr(i, 1)
        If sKey <> "" Then
            If KeyExists(myCol, sKey) = False Then
                myCol.Add "", sKey
                j = j + 1
                ReDim Preserve Result(1 To j)
                Result(j) = sKey
            End If
        End If
    Next i
    UniqueColumnCollection = Result
End Function

'// Sort A-Z cac Item trong Collection'
Public Sub SortingCollection(myCol As Collection, firstIndex As Long, lastIndex As Long)
  Dim valCentre As Variant, vTemp As Variant
  Dim valMin As Long
  Dim valMax As Long
  valMin = firstIndex
  valMax = lastIndex
  valCentre = myCol((firstIndex + lastIndex) \ 2)
  Do While valMin <= valMax
    Do While myCol(valMin) < valCentre And valMin < lastIndex
      valMin = valMin + 1
    Loop
    Do While valCentre < myCol(valMax) And valMax > firstIndex
      valMax = valMax - 1
    Loop
    If valMin <= valMax Then
      ' Swap values
      vTemp = myCol(valMin)
      myCol.Add myCol(valMax), After:=valMin
      myCol.Remove valMin
      myCol.Add vTemp, before:=valMax
      myCol.Remove valMax + 1
      ' Move to next positions
      valMin = valMin + 1
      valMax = valMax - 1
    End If
  Loop
  If firstIndex < valMax Then SortingCollection myCol, firstIndex, valMax
  If valMin < lastIndex Then SortingCollection myCol, valMin, lastIndex
End Sub

'// Truyen cac Items cua Collection vao Array (2 chieu)
Public Function CollectionToArray(myCol As Collection) As Variant
    Dim arr() As Variant, i As Long
    ReDim arr(1 To myCol.Count, 1 To 1)
    For i = 1 To myCol.Count
        arr(i, 1) = myCol.Item(i)
    Next i
    CollectionToArray = arr
End Function

Tải file ví dụ: Collection

VBA Excel FileSystemObject trong Excel VBA

Lê Quốc Thái
-
1
VBA Excel FileSystemObject trong Excel VBA
Các bài viết có liên quan:
 
FileSystemObject (FSo) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), là công cụ chuyên xử lý về Drive, Folder, File.

1. Khai báo

1.1. Kiểu khai báo sớm
(Có Tooltip khi gọi FSo, 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 “Microsoft Scripting Runtime” trong cửa sổ References – VBAProject.
Khai báo trong code:
   
Dim FSo As Scripting.FileSystemObject
Set FSo = New Scripting.FileSystemObject

1.2. Kiểu khai báo muộn
(Không có Tooltip khi gọi FSo, không cần thiết lập trong Tools/References).
Khai báo trong code:
Dim FSo As Object
Set FSo = CreateObject("Scripting.FileSystemObject")

2. Các phương thức

2.1. BuildPath
FSo.BuildPath(Path As String, Name As String) As String

Phương thức BuildPath gán một tên vào một đường dẫn (trả về một chuỗi là đường dẫn).
Path: Bắt buộc. Đường dẫn để nối tên vào.
Name: Bắt buộc. Tên cần nối vào đường dẫn chỉ định.
Ví dụ:
Sub BuildPath()
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Object
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Dim NewPath As String
    NewPath = FSo.BuildPath(ThisWorkbook.Path, "NewFolder")
    MsgBox NewPath
End Sub

2.2. CopyFile
FSo.CopyFile(Source As String, Destination As String, [OverWriteFiles As Boolean = True])

Source: Bắt buộc. Đường dẫn của một hoặc nhiều tập tin cần sao chép (Có thể sử dụng ký tự đại diện “*?”).
Destination: Bắt buộc. Nơi để dán tập tin đã sao chép (ký tự đại diện không thể được sử dụng).
OverWrite: Không bắt buộc. Một giá trị Boolean xác định một tập tin đã tồn tại có thể bị ghi đè hay không. True cho phép các tập tin đã có được ghi đè lên và False ngăn ngừa các tập tin đã có bị ghi đè lên. Mặc định là True.
Ví dụ:
Sub CopyFile()
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sPath As String, dPath As String
    sPath = ThisWorkbook.Path & "\*.xlsx"
    dPath = "D:\Vidu"
    FSo.CopyFile sPath, dPath, True
End Sub

2.3. CopyFolder
FSo.CopyFolder(Source As String, Destination As String, [OverWriteFiles As Boolean = True])

Source: Bắt buộc. Đường dẫn của một hoặc nhiều thư mục cần sao chép (Có thể sử dụng ký tự đại diện “*?”).
Destination: Bắt buộc. Nơi để dán thư mục đã sao chép (ký tự đại diện không thể được sử dụng).
OverWriteFiles: Không bắt buộc. Một giá trị Boolean xác định một thư mục đã tồn tại có thể bị ghi đè hay không. True cho phép các thư mục đã có được ghi đè lên và False ngăn ngừa các thư mục đã có bị ghi đè lên. Mặc định là True.
Ví dụ:
Sub CopyFolders()
'Copy all the folders in "D:\Example"
'to the folder "D:\Vidu"
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Object
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Dim sPath As String, dPath As String
    sPath = "D:\Example\*"
    dPath = "D:\Vidu"
    FSo.CopyFolder sPath, dPath, True
End Sub
'-----------------'
Sub CopyFolder()
'Copy only the folder "OldFolder" in "D:\Example"
'to the folder "D:\Vidu"
'    Dim Fso As Scripting.FileSystemObject
'    Set Fso = New Scripting.FileSystemObject
    Dim FSo As Object
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Dim sPath As String, dPath As String
    sPath = "D:\Example\OldFolder"
    dPath = "D:\Vidu"
    FSo.CopyFolder sPath, dPath, True
End Sub

2.4. CreateFolder
FSo.CreateFolder(Path As String) As Folder

Path: Bắt buộc. Là đường dẫn của thư mục cần tạo.
Nếu thư mục cần tạo đã tồn tại thì sẽ gặp lỗi, cần kiểm tra sự tồn tại trước khi tạo mới.
Ví dụ:
Sub CreateFolder()
'FSo.CreateFolder(Path As String) As Folder
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    FSo.CreateFolder (ThisWorkbook.Path & "\NewFolder")
    'Gap loi neu thu muc da ton tai, can kiem tra su ton tai cua thu muc do truoc khi dung .CreateFolder
End Sub

2.5. CreateTextFile
FSo.CreateTextFile(FileName As String, [OverWrite As Boolean = True], [Unicode As Boolean = False]) As TextStream

Tạo một tập tin văn bản dạng TextStream trong một thư mục chỉ định, có thể đọc và viết vào tập tin đó.
FileName: Bắt buộc. Là đường dẫn đầy đủ của tập tin cần tạo.
OverWrite. Không bắt buộc. Thiết lập cho phép có ghi đè tập tin đã tồn tại hay không. Mặc định là True, tức là cho phép ghi đè tập tin đã tồn tại. Ngược lại, False tức là không cho phép ghi đè.
Unicode: Không bắt buộc. Thiết lập tập tin văn bản được tạo dưới định dạng Unicode (ứng với True) hay ASCII (ứng với False). Mặc định là False.
Ví dụ:
Sub CreateTextFile()
'FSo.CreateTextFile(FileName As String, [OverWrite As Boolean = True], [Unicode As Boolean = False]) As TextStream
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim nameText As String, TxtFile As TextStream
    nameText = ThisWorkbook.Path & "\NewText.txt"
    Set TxtFile = FSo.CreateTextFile(nameText, True, True)
    TxtFile.WriteLine ("Hello World!")
    TxtFile.WriteLine ("This is a example!")
    TxtFile.Close
End Sub

2.6. DeleteFile
FSo.DeleteFile(FileSpec As String, [Force As Boolean = False])

FileSpec: Bắt buộc. Đường dẫn của một hoặc nhiều tập tin cần xóa, cho phép dùng ký tự đại diện (*?).
Force: Không bắt buộc. Thiết lập cho phép tập tin có thuộc tính Read-Only có bị xóa hay không. True cho phép tập tin Read-Only bị xóa, False thì chúng không bị xóa. Mặc định là False.
Lưu ý: Gặp lỗi nếu tập tin không tồn tại.
Ví dụ:
Sub DeleteFile()
'FSo.DeleteFile(FileSpec As String, [Force As Boolean = False])
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim nameText As String
    nameText = ThisWorkbook.Path & "\NewText.txt"
    FSo.CreateTextFile nameText, True, False
    'nameText = ThisWorkbook.Path & "\*.txt"
    FSo.DeleteFile nameText, True
    'Gap loi neu tap tin can xoa khong ton tai
End Sub

2.7. DeleteFolder
FSo.DeleteFolder(FolderSpec As String, [Force As Boolean = False])

FolderSpec: Bắt buộc. Là đường dẫn của một hoặc nhiều thư mục cần xóa, cho phép dùng ký tự đại diện.
Force: Không bắt buộc. Thiết lập cho phép thư mục có thuộc tính Read-Only có bị xóa hay không. True cho phép thư mục Read-Only bị xóa, False thì chúng không bị xóa. Mặc định là False.
Lưu ý: Gặp lỗi nếu thư mục không tồn tại.
Ví dụ:
Sub DeleteFolder()
'FSo.DeleteFolder(FolderSpec As String, [Force As Boolean = False])
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    FSo.DeleteFolder (ThisWorkbook.Path & "\NewFolder")
    'FSo.DeleteFolder (ThisWorkbook.Path & "\?")
End Sub

2.8. DriveExists
FSo.DriveExists(DriveSpec As String) As Boolean

Kiểm tra sự tồn tại của một ổ đĩa. Trả về True nếu nó tồn tại, ngược lại trả về False.
DriveSpec: Bắt buộc. Tên ổ đĩa cần kiểm tra.
Ví dụ:
Sub DriveExists()
'FSo.DriveExists(DriveSpec As String) As Boolean
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.DriveExists("C:\")
End Sub

2.9. FileExists
FSo.FileExists(FileSpec As String) As Boolean

Kiểm tra sự tồn tại của một tập tin. Trả về True nếu nó tồn tại, ngược lại trả về False.
FileSpec: Bắt buộc. Đường dẫn đầy đủ của tập tin cần kiểm tra.
Ví dụ:
Sub FileExists()
'FSo.FileExists(FileSpec As String) As Boolean
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.FileExists(ThisWorkbook.FullName)
End Sub

2.10. FolderExists
FSo.FolderExists(FolderSpec As String) As Boolean

Kiểm tra sự tồn tại của một thư mục. Trả về True nếu nó tồn tại, ngược lại trả về False.
FolderSpec: Bắt buộc. Đường dẫn đầy đủ của thư mục cần kiểm tra.
Ví dụ:
Sub FolderExists()
'FSo.FolderExists(FolderSpec As String) As Boolean
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.FolderExists(ThisWorkbook.Path)
End Sub

2.11. GetAbsolutePathName
FSo.GetAbsolutePathName(Path As String) As String

Trả về đường dẫn đầy đủ từ ổ đĩa cho đường dẫn đưa vào.
Path: Bắt buộc. Là đường dẫn gợi ý để trả về đường dẫn đầy đủ.
Ví dụ: 
Sub GetAbsolutePathName()
'FSo.GetAbsolutePathName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sPath As String
    sPath = FSo.GetAbsolutePathName(ThisWorkbook.Name)
    MsgBox sPath
End Sub

2.12. GetBaseName
FSo.GetBaseName(Path As String) As String

Trả về tên cơ sở của một tập tin (tên của tập tin không gồm phần mở rộng) hoặc tên của thư mục cho thành phần cuối cùng trong một đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn của tập tin hay thư mục đưa vào.
Lưu ý: Path có thể là đường dẫn của tập tin hoặc thư mục.
Ví dụ:
Sub GetBaseName()
'FSo.GetBaseName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sPath As String
    sPath = FSo.GetBaseName(ThisWorkbook.Name)
    'sPath = FSo.GetBaseName(ThisWorkbook.Path)
    MsgBox sPath
End Sub

2.13. GetDrive
FSo.GetDrive(DriveSpec As String) As Drive

Trả về đối tượng Drive (ổ đĩa) tương ứng với ổ đĩa trong đường dẫn chỉ định đưa vào.
DriveSpec: Bắt buộc. Có thể ở dạng tên ổ đĩa (C,D,E), hoặc ở dạng (C:, D: ), ở dạng (C:\, D:\ ), hoặc ở dạng chia sẻ trong LAN (\\Computer\Folder2).
Đối tượng Drive có 12 thuộc tính.
Ví dụ:
Sub GetDrive()
'FSo.GetDrive(DriveSpec As String) As Drive
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim dDrive As Drive
    Set dDrive = FSo.GetDrive("C:\")
    MsgBox GetDriveProperties(dDrive)
End Sub

Public Function GetDriveProperties(ByVal dDrive As Drive) As String
    Dim Result()
    ReDim Result(1 To 20)
    With dDrive
        Result(1) = "AvailableSpace: " & .AvailableSpace
        Result(2) = "DriveLetter: " & .DriveLetter
        Result(3) = "DriveType: " & .DriveType
        Result(4) = "FileSystem: " & .FileSystem
        Result(5) = "FreeSpace: " & .FreeSpace
        Result(6) = "IsReady: " & .IsReady
        Result(7) = "Path: " & .Path
        Result(8) = "RootFolder: " & .RootFolder
        Result(9) = "SerialNumber: " & .SerialNumber
        Result(10) = "ShareName: " & .ShareName
        Result(11) = "TotalSize: " & .TotalSize
        Result(12) = "VolumeName: " & .VolumeName
    End With
    ReDim Preserve Result(1 To 12)
    GetDriveProperties = Join(Result, vbCrLf)
End Function

2.14. GetDriveName
FSo.GetDriveName(Path As String) As String

Trả về tên ổ đĩa từ đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn đưa vào sẽ trả về tên ổ đĩa.
Ví dụ:
Sub GetDriveName()
'FSo.GetDriveName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    MsgBox FSo.GetDriveName(ThisWorkbook.Path)  'C:
End Sub

2.15. GetExtensionName
FSo.GetExtensionName(Path As String) As String

Trả về phần mở rộng của tập tin.
Path: Bắt buộc. Là đường dẫn đầy đủ của tập tin.
Ví dụ:
Sub GetExtensionName()
'FSo.GetExtensionName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim extFile As String
    extFile = FSo.GetExtensionName(ThisWorkbook.FullName)
    MsgBox extFile
End Sub

2.16. GetFile
FSo.GetFile(FilePath As String) As File

Trả về đối tượng File.
FilePath: Bắt buộc. Là đường dẫn đầy đủ của tập tin.
Đối tượng File có 12 thuộc tính, 4 phương thức.
Ví dụ:
Sub GetFile()
'FSo.GetFile(FilePath As String) As File
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFile As File
    Set oFile = FSo.GetFile(ThisWorkbook.FullName)
    MsgBox GetFileProperties(oFile)
End Sub

Public Function GetFileProperties(ByVal oFile As File) As String
    Dim Result()
    ReDim Result(1 To 20)
    With oFile
        Result(1) = "Attributes: " & .Attributes
        Result(2) = "DateCreated: " & .DateCreated
        Result(3) = "DateLastAccessed: " & .DateLastAccessed
        Result(4) = "DateLastModified: " & .DateLastModified
        Result(5) = "Drive: " & .Drive
        Result(6) = "Name: " & .Name
        Result(7) = "ParentFolder: " & .ParentFolder
        Result(8) = "Path: " & .Path
        Result(9) = "ShortName: " & .ShortName
        Result(10) = "ShortPath: " & .ShortPath
        Result(11) = "Size: " & .Size
        Result(12) = "Type: " & .Type
    End With
    ReDim Preserve Result(1 To 12)
    GetFileProperties = Join(Result, vbCrLf)
End Function

Các phương thức của đối tượng File: Copy, Delete, Move, OpenTextStream
Sub FileMethods()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFile As File
    Set oFile = FSo.GetFile(ThisWorkbook.FullName)
    'oFile.Copy (Destination As String, [OverWriteFiles As Boolean = True])
    'oFile.Delete([Force As Boolean = False])
    'oFile.Move(Destination As String)
    'oFile.OpenAsTextStream([IOMode As IOMode = ForReading],[Format As Tristate = TristateFalse]) As TextStream

    oFile.Copy "D:\", True
End Sub

2.17. GetFileName
FSo.GetFileName(Path As String) As String

Trả về tên của tập tin gồm cả phần mở rộng hoặc tên của thư mục cho thành phần cuối cùng trong một đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn của tập tin hoặc thư mục chỉ định.
Phương thức GetFileName trả về một chuỗi chứa tên tệp tin hoặc tên thư mục cho thành phần cuối cùng trong một đường dẫn được chỉ định.
Lưu ý:
– Nếu Path là đường dẫn của File thì:
GetFileName = GetBaseName & "." & GetExtensionName
GetFileName = oFile.Name

– Nếu Path là đường dẫn của Folder thì:
GetFileName = GetBaseName

Ví dụ:
Sub GetFileName()
'FSo.GetFileName(Path As String) As String
'1 - Nêu Path là File:
    'GetFileName = GetBaseName & "." & GetExtensionName
    'GetFileName = oFile.Name
'2 - Nêu Path là Folder:
    'GetFileName = GetBaseName
    
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim fName As String
    fName = FSo.GetFileName(ThisWorkbook.FullName)
    'fName = FSo.GetFileName(ThisWorkbook.Path)
    MsgBox fName
End Sub

2.18. GetFolder
FSo.GetFolder(FolderPath As String) As Folder

Trả về đối tượng Folder (thư mục).
FolderPath: Bắt buộc. Là đường dẫn của thư mục chỉ định.
Đối tượng Folder có 15 thuộc tính, 4 phương thức.
Lưu ý: Hai thuộc tính của đối tượng Folder: Files và SubFolders trả về một Collection (*).
Ví dụ:
Sub GetFolder()
'FSo.GetFolder(FolderPath As String) As Folder
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFolder As Folder
    Set oFolder = FSo.GetFolder(ThisWorkbook.Path)
    MsgBox GetFolderProperties(oFolder)
End Sub

Public Function GetFolderProperties(ByVal oFolder As Folder) As String
    Dim Result()
    ReDim Result(1 To 20)
    With oFolder
        Result(1) = "Attributes: " & .Attributes
        Result(2) = "DateCreated: " & .DateCreated
        Result(3) = "DateLastAccessed: " & .DateLastAccessed
        Result(4) = "DateLastModified: " & .DateLastModified
        Result(5) = "Drive: " & .Drive
        Result(6) = "Files.Count: " & .Files.Count
        Result(7) = "IsRootFolder: " & .IsRootFolder
        Result(8) = "Name: " & .Name
        Result(9) = "ParentFolder: " & .ParentFolder
        Result(10) = "Path: " & .Path
        Result(11) = "ShortName: " & .ShortName
        Result(12) = "ShortPath: " & .ShortPath
        Result(13) = "Size: " & .Size
        Result(14) = "SubFolders.Count: " & .SubFolders.Count
        Result(15) = "Type: " & .Type
    End With
    ReDim Preserve Result(1 To 15)
    GetFolderProperties = Join(Result, vbCrLf)
End Function

Các phương thức của đối tượng Folder: Copy, CreateTextFile, Delete, Move
Sub FolderMethods()
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim oFolder As Folder
    Set oFolder = FSo.GetFolder(ThisWorkbook.Path)
    'oFolder.Copy(Destination As String, [OverWriteFiles As Boolean = True])
    'oFolder.CreateTextFile(FileName As String, [OverWrite As Boolean = True], [Unicode As Boolean = False]) As TextStream
    'oFolder.Delete(Force As Boolean = False])
    'oFolder.Move(Destination As String)
    
    oFolder.Copy "D:\", True
End Sub 
   

2.19. GetParentFolderName
FSo.GetParentFolderName(Path As String) As String

Trả về đường dẫn của thư mục chính (thư mục cha) của thành phần cuối cùng trong một đường dẫn chỉ định đưa vào.
Path: Bắt buộc. Là đường dẫn của một tập tin hoặc một thư mục chỉ định.
Ví dụ:
Sub GetParentFolderName()
'FSo.GetParentFolderName(Path As String) As String
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sFolder As String
    sFolder = FSo.GetParentFolderName(ThisWorkbook.FullName)
    'sFolder = FSo.GetParentFolderName(ThisWorkbook.Path)
    MsgBox sFolder
End Sub

2.20. GetSpecialFolder
FSo.GetSpecialFolder(SpecialFolder as SpecialFolderConst) As Folder

Trả về đối tượng Folder (thư mục) đặc biệt của hệ điều hành Windows.
SpecialFolder: Bắt buộc. Là hằng số tương ứng với thư mục đặc biệt của Windows.
0 = WindowsFolder     – Contains files installed by the Windows operating system
1 = SystemFolder       – Contains libraries, fonts, and device drivers
2 = TemporaryFolder   – Used to store temporary files

Ví dụ:
Sub GetSpecialFolder()
'FSo.GetSpecialFolder(SpecialFolder as SpecialFolderConst) As Folder
    'SpecialFolderConst:
        '0=WindowsFolder - Contains files installed by the Windows operating system
        '1=SystemFolder - Contains libraries, fonts, and device drivers
        '2=TemporaryFolder - Used to store temporary files
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim specFolder As Folder
    Set specFolder = FSo.GetSpecialFolder(0)
    MsgBox specFolder.Name  'Windows
End Sub

2.21. GetTempName
FSo.GetTempName

Trả về tên một tập tin *.tmp ngẫu nhiên.

Ví dụ:
Sub GetTempName()
'FSo.GetTempName
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim tmpFile As String, specFolder As Folder
    Set specFolder = FSo.GetSpecialFolder(2)
    tmpFile = FSo.GetTempName
    MsgBox tmpFile
    'specFolder.CreateTextFile (tmpFile) 'Create a temp file in the "Temp" folder.
End Sub

2.22. MoveFile

FSo.MoveFile(Source As String, Destination As String)

Di chuyển một hoặc nhiều tập tin (Files) tới địa chỉ chỉ định.
Sourve: Bắt buộc. Tên của môt hoặc nhiều tập tin cần di chuyển, có thể sử dụng ký tự đại diện (*?).
Destination: Đường dẫn địa chỉ cần di chuyển tới. Không thể sử dụng ký tự đại diện.
Ví dụ:
Sub MoveFile()
'FSo.MoveFile(Source As String, Destination As String)
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sFiles As String, dPath As String
    sFiles = "D:\Example\*.txt"
    dPath = "E:\NewFolder"
    FSo.MoveFile sFiles, dPath
End Sub

2.23. MoveFolder

FSo.MoveFolder(Sourve As String, Destination As String)

Di chuyển một hoặc nhiều thư mục (Folders) tới địa chỉ chỉ định.
Sourve: Bắt buộc. Tên của môt hoặc nhiều thư mục cần di chuyển, có thể sử dụng ký tự đại diện (*?).
Destination: Đường dẫn địa chỉ cần di chuyển tới. Không thể sử dụng ký tự đại diện.
Ví dụ:
Sub MoveFolder()
'FSo.MoveFolder(Sourve As String, Destination As String)
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim sFolders As String, dPath As String
    sFolders = "D:\Example2\*"
    dPath = "E:\NewFolder2"
    FSo.MoveFolder sFolders, dPath
End Sub

2.24. OpenTextFile

FSo.OpenTextFile(FileName As String, [IOMode As IOMode = ForReading], [Create As Boolean = False], [Format As Tristate = TristateFalse]) as TextStream

Mở ra một tệp được chỉ định và trả về một đối tượng TextStream có thể được sử dụng để truy cập tập tin đó.
FileName: Bắt buộc. Là đường dẫn của tập tin cần mở.
IOMode: Không bắt buộc. Thiết lập kiểu mở tập tin. Mặc định là ForReading.
1 = ForReading – Mở một tập tin để đọc. Không thể ghi thêm nội dung vào tập tin
2 = ForWriting – Mở một tập tin để ghi thêm nội dung.
8 = ForAppending – Mở một tập tin và ghi vào cuối của tập tin.
Create: Không bắt buộc. Thiết lập liệu một tập tin mới có thể được tạo ra nếu tên tập tin đưa vào không tồn tại. True tức là tạo một tập tin mới, False không tạo một tập tin mới. Mặc định là False.
Format: Không bắt buộc. Là định dạng mở tập tin.
0 = TristateFalse – Mở tệp dưới dạng ASCII. Đây là giá trị mặc định.
-1 = TristateTrue – Mở tập tin dưới dạng Unicode.
-2 = TristateUseDefault – Mở tập tin bằng cách sử dụng hệ thống mặc định.
Ví dụ:
Sub OpenTextFile()
'FSo.OpenTextFile(FileName As String, [IOMode As IOMode = ForReading], [Create As Boolean = False], [Format As Tristate = TristateFalse]) as TextStream
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim txtFile As TextStream, sText As String
    Set txtFile = FSo.OpenTextFile("D:\Test1.txt", ForReading, False, TristateUseDefault)
    sText = txtFile.ReadAll
    txtFile.Close
    MsgBox sText
End Sub

Public Function ReadTextFile(ByVal pathTextFile As String) As String
    Dim FSo As Object
    Dim txtFile As TextStream
    Dim sText As String
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set txtFile = FSo.OpenTextFile(pathTextFile, 1, False, -2)
    sText = txtFile.ReadAll
    txtFile.Close
    ReadTextFile = sText
End Function

3. Thuộc tính

3.1. Thuộc tính Drives của FSo

FSo.Drives

Trả về một Collection, cung cấp chi tiết về tất cả các ổ đĩa (Drives) được gắn vào hệ thống, hoặc là vật lý hoặc là logic. Có 2 thuộc tính: Count và Item
Count: Trả về số ổ đĩa được gắn vào hệ thống. 
FSo.Drives.Count

Item: Trả về đối tượng ổ đĩa (Drive) theo Key chỉ định.
FSo.Drives.Item(Key) As Drive
Hoặc
FSo.Drives(Key) As Drive

Tương đương với phương thức GetDrive của FSo: FSo.GetDrive(DriveSpec As String) As Drive

Ví dụ:
Sub Drives()
'FSo.Drives:
    '1:
    'FSo.Drives.Count               'Tra ve so luong o dia gan vao he thong
    '2:
    'FSo.Drives.Item(Key) As Drive  'Tra ve doi tuong o dia theo key chi dinh
    'FSo.Drives(Key) As Drive       'Tra ve doi tuong o dia theo key chi dinh
    '= FSo.GetDrive(DriveSpec As String) As Drive       'Phuong thuc GetDrive cua FSo

    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim objDrive As Drive, countDrives As Long
    countDrives = FSo.Drives.Count
    MsgBox countDrives
    Set objDrive = FSo.Drives.Item("C:")
    MsgBox objDrive.DriveLetter
    'Or:
    'Set objDrive = FSo.Drives("C:")
    'Or:
    'Set objDrive =FSo.GetDrive ("C:\")
End Sub

3.2. Chú thích (*):

Hai thuộc tính của đối tượng Folder: Files và SubFolders trả về một Collection (mở mục 2.18).

a. Thuộc tính Files của Folder

objFolder.Files

Trả về một Collection, cung cấp tất cả các tập tin (Files) có trong thư mục đó.
Có 2 thuộc tính: Count và Item
Count: Trả về số lượng tập tin có trong thư mục đó.
objFolder.Files.Count

Item: Trả về đối tượng File theo Key chỉ định.
objFolder.Files.Item(Key) As File
'Hoặc:
objfolder.Files(Key) As File

Tương đương với phương thức GetFile của FSo: FSo.GetFile(FilePath As String) As File
Ví dụ:
Sub FolderProperties_Files()
'objFolder.Files:
    '1:
    'objFolder.Files.Count              'Tra ve so luong Files trong Folder
    '2:
    'objFolder.Files.Item(Key) As File  'Tra ve duoi tuong File theo Key chi dinh
    'objfolder.Files(Key) As File       'Tra ve duoi tuong File theo Key chi dinh
    '= FSo.GetFile(FilePath As String) As File  'Phuong thuc GetFile cua FSo

    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim objFolder As Folder, countFiles As Long
    Set objFolder = FSo.GetFolder(ThisWorkbook.Path)
    countFiles = objFolder.Files.Count
    MsgBox countFiles
End Sub

b. Thuộc tính SubFolders của Folder

objFolder.SubFolders

Trả về một Collection, cung cấp tất cả các thư mục (Folders) có trong thư mục đó.
– Có 1 phương thức: Add
    Tạo mới một Folder:
objFolder.SubFolders.Add(Name As String) As Folder

    Tương đương với phương thức CreateFolder của FSo: FSo.CreateFolder(Path As String) As Folder
– Có 2 thuộc tính: Count và Item
Count: Trả về số lượng Folders có trong Folder chỉ định đưa vào.
objFolder.SubFolders.Count

Item: Trả về đối tượng Folder theo Key chỉ định
objFolder.SubFolders.Item(Key) As Folder
'Hoặc:
objFolder.SubFolders(Key) As Folder

    Tương đương với phương thức GetFolder của FSo: FSo.GetFolder(FolderPath As String) As Folder        
Ví dụ:
Sub FolderProperties_SubFolders()
'objFolder.SubFolders:
    '1:
    'objFolder.SubFolders.Add(Name As String) As Folder     'Tao mot Folder
    '= FSo.CreateFolder(Path As String) As Folder           'Tuong duong voi phuong thuc CreateFolder cua FSo
    '2:
    'objFolder.SubFolders.Count                             'Tra ve so luong Folders co trong Folder dang xet
    '3:
    'objFolder.SubFolders.Item(Key) As Folder               'Tra ve duoi tuong Folder theo Key chi dinh
    'objFolder.SubFolders(Key) As Folder                    'Tra ve duoi tuong Folder theo Key chi dinh
    '= FSo.GetFolder(FolderPath As String) As Folder        'Tuong duong voi phuong thuc GetFolder cua FSo
    Dim FSo As Scripting.FileSystemObject
    Set FSo = New Scripting.FileSystemObject
    Dim objFolder As Folder, countFolders As Long, oFolder As Folder, sFolder As String
    Set objFolder = FSo.GetFolder(ThisWorkbook.Path)
    sFolder = "NewFolder2"
    countFolders = objFolder.SubFolders.Count
    If FSo.FolderExists(objFolder.Path & "\" & sFolder) = False Then
        objFolder.SubFolders.Add sFolder
    End If
    Set oFolder = objFolder.SubFolders.Item(sFolder)
    If objFolder.SubFolders.Count > countFolders Then
        MsgBox "The new folder is: " & oFolder.Name
    End If
End Sub

4. Một số Sub/ Function

'// Tra ve chuoi la noi dung cua text file theo duong dan chi dinh
Public Function ReadTextFile(ByVal pathTextFile As String) As String
    Dim FSo As Object, txtFile As TextStream, sText As String
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set txtFile = FSo.OpenTextFile(pathTextFile, 1, False, -2)
    sText = txtFile.ReadAll
    txtFile.Close
    ReadTextFile = sText
End Function

'// Tra ve danh sach Files trong mot Folder chi dinh, theo kieu loai File chi dinh (co the su dung ky tu dai dien *?)
'typeName=0: Tra ve danh sach ten cua File (File.Name, gom phan mo rong cua File)
'typeName=1: Tra ve danh sach ten co so cua File (BaseName, khong gom phan mo rong cua File)
'typeName=2: Tra ve danh sach duong dan day du cua File (File.Path)
'typeName=3: Tra ve danh sach duong dan rut gon cua File (File.ShortPath)
Public Function GetFilesInFolder(ByVal pathFolder As String, ByVal extensionFile As String, Optional ByVal typeName As Byte = 0)
    Dim FSo As Object, objFolder As Folder, objFile As File, Result(), i As Long
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSo.GetFolder(pathFolder)
    extensionFile = VBA.UCase(extensionFile)
    For Each objFile In objFolder.Files
        If VBA.UCase(FSo.GetExtensionName(objFile)) Like extensionFile Then
            i = i + 1
            ReDim Preserve Result(1 To i)
            Select Case typeName
                Case 0
                    Result(i) = objFile.Name
                Case 1
                    Result(i) = FSo.GetBaseName(objFile.Path)
                Case 2
                    Result(i) = objFile.Path
                Case 3
                    Result(i) = objFile.ShortPath
            End Select
         End If
    Next objFile
    GetFilesInFolder = Result
End Function

'// Tra ve duong dan day du cua Folder duoc chon. Neu khong chon thi tra ve chuoi rong (len(chuoi)=0)
Public Function GetPathFolder(ByVal pathFolder As String) As String
    Dim fDlog As FileDialog, sItem As String
    Set fDlog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDlog
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = pathFolder
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetPathFolder = sItem
    Set fDlog = Nothing
End Function

'// Xoa Files trong Folder chi dinh, loai File chi dinh (co the su dung ky tu dai dien *?)
'=== Ghi chu: Can trong khi su dung ===
Public Sub DeleteFiles(ByVal pathFolder As String, ByVal extensionFile As String, Optional ByVal Force As Boolean = False)
    Dim FSo As Object, objFile As File
    Set FSo = CreateObject("Scripting.FileSystemObject")
    extensionFile = VBA.UCase(extensionFile)
    With FSo.GetFolder(pathFolder)
      For Each objFile In .Files
         If VBA.UCase(FSo.GetExtensionName(objFile)) Like extensionFile Then
            FSo.DeleteFile objFile, Force
         End If
      Next objFile
   End With
End Sub

'// Xoa tat ca Folders trong Folder chi dinh
'=== Ghi chu: Can trong khi su dung ===
Public Sub DeleteFolders(ByVal pathFolder As String, Optional ByVal Force As Boolean = False)
    Dim FSo As Object, objFolder As Folder
    Set FSo = CreateObject("Scripting.FileSystemObject")
    With FSo.GetFolder(pathFolder)
      For Each objFolder In .SubFolders
            FSo.DeleteFolder objFolder, Force
      Next
   End With
End Sub

'// Xoa tat ca Files va Folders trong Folder chi dinh
'=== Ghi chu: Can trong khi su dung ===
Public Sub DeleteAll(ByVal pathFolder As String, Optional ByVal Force As Boolean = False)
    Dim FSo As Object, objFolder As Folder, objFile As File
    Set FSo = CreateObject("Scripting.FileSystemObject")
    With FSo.GetFolder(pathFolder)
      For Each objFolder In .SubFolders
            FSo.DeleteFolder objFolder, Force
      Next
      For Each objFile In .Files
         FSo.DeleteFile objFile, Force
      Next objFile
   End With
End Sub

Tải file ví dụ: FileSystemObject

VBA Excel Array Mảng trong Excel VBA

Lê Quốc Thái
-
0
VBA Excel Array Mảng trong Excel VBA
  1. Loạt các bài viết có liên quan chuyên đề VBA:
  2. VBA Excel Hộp thoại thông báo
  3. VBA Excel Biến trong VBA Excel
  4. VBA Excel sử dụng Scripting Dictionary
  5. VBA Excel Biến trong VBA Excel
  6. VBA Excel Workbook, worksheet
  7. VBA Excel Range, Cells
  8. VBA Excel Hàm trong Excel VBA
  9. VBA Excel Events, Application Object
  10. VBA Excel Function and Sub Excel VBA
  11. VBA Excel Array Mảng trong Excel VBA
  12. VBA Excel FileSystemObject trong Excel VBA
  13. VBA Excel Collection trong Excel VBA
  14. VBA Excel Hashtable trong Excel VBA
  15. VBA Excel Stack trong Excel VBA
  16. VBA Excel Queue trong Excel VBA
  17. VBA Excel SortedList Excel VBA
  18. VBA Excel ArrayList Excel VBA
  19. VBA Excel Ví dụ về Scripting Dictionary
  20. Sách VBA Excel 2016 power programming with vba (pdf)

 1. Khái quát chung

Mảng (array) là một tập hợp của nhiều phần tử được gọi thông qua một tên.

Ví dụ: Arr

Ta xác định phần tử trong mảng thông qua địa chỉ của phần tử đó trong mảng.

Ví dụ: Arr(2): Tức là gọi tới phần tử có địa chỉ thứ tự là 2 trong mảng Arr.

Phân loại:

Theo kích thước của mảng, chia thành: mảng 1 chiều và mảng nhiều chiều.

Ví dụ:

Mảng 1 chiều: Arr(5)

Mảng 2 chiều: Arr2(4, 9)

Mảng 3 chiều: Arr3(5,12,30)

Theo tính chất về khả năng thay đổi (khai báo lại) kích thước của mảng trong quá trình sử dụng, chia thành: mảng tĩnh, mảng động.

Khai báo mảng:

 

Public | Private | Dim | Static Arr([Lower To] Upper) [As type of variables]

– Public | Private | Dim | Static: Là các từ khóa để khai báo biến mảng.

(xem chi tiết ở Bài 4. Biến trong VBA)

– Arr: Tên của biến mảng cần khai báo, tuân theo quy tắc đặt tên một biến.

– Lower: Cận dưới một chiều của mảng (*).

– Upper: Cận trên một chiều của mảng

– To: Là từ khóa

– As type of variables: Kiểu dữ liệu của các phần từ trong mảng Arr.

Nếu mảng gồm nhiều chiều thì các chiều được ngăn cách bởi dấu phẩy.

(*) Chú thích: Cận dưới một chiều của mảng mặc định Lower=0, tức là mặc định trong VBA Option Base 0.

Ví dụ:

         Dim Arr1(5): Tương ứng với Dim Arr1(0 To 5), mảng 1 chiều có 6 phần tử.

         Dim Arr2(6, 9): Tương ứng với Dim Arr(0 To 6, 0 To 9), mảng 2 chiều, chiều thứ nhất (0-6), chiều thứ hai (0-9).

Để thay đổi cận dưới mặc định này ta khai báo ở trên cùng của module cần thay đổi:

         Option Base 1

Khi đó: Dim Arr1(5) sẽ tương ứng Dim Arr1(1 To 5).

Kích thước của mảng:

Dùng 2 hàm LBound() và UBound() để xác định cận dưới và cận trên của mảng.

LBound(ArrayName, Dimension) 

 

UBound(ArrayName, Dimension

ArrayName: Tên mảng.

Dimension: Chiều của mảng cần xác định.

Kích thước của một chiều thứ i của mảng Arr = UBound(Arr,i) – Lbound(Arr,i) + 1.
Kích thước lớn nhất mỗi chiều của mảng là 2^31 – 1. Tuy nhiên, mảng đó có hoạt động được hay không còn phụ thuộc vào bộ nhớ của máy tính, nếu mảng có kích thước vượt quá bộ nhớ khả dụng của máy tính sẽ gặp lỗi “Out of memory”.
Tham khảo thêm Array Size.
Ví dụ:

Sub L_UBound()
    Dim Arr(1 To 10, 1 To 4)
    MsgBox LBound(Arr, 1) & " - " & UBound(Arr, 1)  'Result: 1 - 10
    MsgBox LBound(Arr, 2) & " - " & UBound(Arr, 2) 'Result: 1- 4
End Sub

 

Ứng dụng của mảng trong viết code: Tăng tốc cho code.

Theo tính chất khi sử dụng, ta xét mảng tĩnh và mảng động.

2. Mảng tĩnh

Một mảng tĩnh là mảng có số chiều, kích thước của chiều được khai báo cụ thể ngay từ đầu.

Dim StaticArr (1 đến 20) As Long

Không thể thay đổi kích thước hoặc kiểu dữ liệu của mảng tĩnh (Redim / Redim Preserve).

Khi thực hiện xóa một mảng tĩnh (Erase StaticArr), không có bộ nhớ nào được giải phóng. Khi đó, việc xóa đó đơn giản là đặt lại tất cả các phần tử của mảng về giá trị mặc định của chúng (0, vbNullString, Empty hoặc Nothing, tùy thuộc vào kiểu dữ liệu của mảng đó đã được khai báo).

Ví dụ: 

Dim Arr(1 To 8) 'Mảng 1 chiều có 8 phần từ (1-8) 

 

Dim Arr2(1 to 9, 1 To 1) 'Mảng 2 chiều, chiều 1 có 9 phần tử (1-9), chiều 2 có 1 phần từ (1-1)

Kích thước khai báo phải là một hằng số cụ thể, không thể khai báo thông qua một biến.

Đúng:

Dim A(1 to 3) 
Dim A1( 1 to 4, 1 to 9)

Không đúng: 

Sub KhaiBaoLoi()
    Dim n As Long
    n = 5
    Dim Arr(1 To n) 'Error: Constant expression required
End Sub

3. Mảng động

Khi chưa xác định được số chiều và kích thước chiều của mảng cần khai báo, ta dùng mảng động. Mảng động cho phép khai báo số chiều, kích thước mỗi chiều của mảng sau.

Ví dụ: 

Dim Arr1() As Long, Arr2() As String 

 

'Ta mới chỉ khai báo biến mảng nhưng chưa biết số chiều, kích thước của chiều.'

Mảng động cho phép thay đổi kích thước của mảng, nhưng không thể thay đổi kiểu dữ liệu của mảng.

Khi thực hiện xóa (Erase) một mảng động, bộ nhớ được phân bổ cho mảng đó được giải phóng. Để sử dụng mảng động sau khi Erase cần thực hiện ReDim mảng động đó.

Khi đã xác định được số chiều và kích thước của chiều ta tiến hành khai báo lại cho mảng, với từ khóa Redim

Ví dụ: 

Sub Arr_Dynamic_1()
    Dim Arr1() As Long, Arr2() As Long, m As Long, n As Long, i As Long
    m = 50
    n = 60
    ReDim Arr1(1 To m)          '1.1'
    ReDim Arr2(1 To m, 1 To 1)  '1.2'
    For i = 1 To m              'Vòng lap gán giá tri vào mang'
        Arr1(i) = i
        Arr2(i, 1) = i
    Next i
    ReDim Arr1(1 To n)          '2.1'
    ReDim Arr2(1 To m, 1 To n)  '2.2'
    MsgBox "Arr1(1) = " & Arr1(1) & vbNewLine & "Arr2(1,1) = " & Arr2(1, 1)
    'Result: Arr1(1) = 0  |  Arr2(1,1) = 0'
End Sub

Trong ví dụ trên, ban đầu ta khai báo 2 biến mảng Arr1(), Arr2() nhưng chưa khai báo số chiều và kích thước của chiều.

Tiếp đó, ta khai báo lại lần thứ nhất (1.1 và 1.2) 2 mảng đó với số chiều và kích thước cụ thể:

ReDim Arr1(1 To m): mảng có 1 chiều, có m -1 +1 = 50 phần tử.

ReDim Arr2(1 To m, 1 To 1): mảng 2 chiều, chiều 1 có kích thớc m -1 +1 = 50, chiều 2 có kích thớc là 1.

Tiếp theo, ta gán các giá trị cho các phần tử trong mảng (vòng lặp For Next).

Sau đó, ta khai báo lại lần thứ hai (2.1 và 2.2) 2 mảng đó với số chiều và kích thước cụ thể:

ReDim Arr1(1 To n): mảng có 1 chiều, có n -1 +1 = 60 phần tử.

ReDim Arr2(1 To m, 1 To n): mảng 2 chiều, chiều 1 có kích thớc m -1 +1 = 50, chiều 2 có kích thước n -1 +1 = 60.

Lưu ý ở đây:

– Sau khi Redim để khai báo thay đổi số chiều và kích thước của chiều thì các phần tử trong mảng trước đó đều bị xóa.

– Khi cần khai báo lại để thay đổi kích thước của mảng mà vẫn giữ các phần từ đã có thì ta dùng Redim Preserve. Tuy nhiên, cần chú ý rằng Redim Preserve chỉ áp dụng được để thay đổi kích thước chiều cuối cùng của mảng.

Ví dụ:

Sub Arr_Dynamic_2()
    Dim Arr1() As Long, Arr2() As Long, m As Long, n As Long, i As Long
    m = 50
    n = 60
    ReDim Arr1(1 To m)          '1.1'
    ReDim Arr2(1 To m, 1 To 1)  '1.2'
    For i = 1 To m              'Vòng lap gán giá tri vào mang'
        Arr1(i) = i
        Arr2(i, 1) = i
    Next i
    ReDim Preserve Arr1(1 To n)             '2.1'
    ReDim Preserve Arr2(1 To m, 1 To n)     '2.2'
    MsgBox "Arr1(1) = " & Arr1(1) & vbNewLine & "Arr2(1,1) = " & Arr2(1, 1)
    'Result: Arr1(1) = 1  |  Arr2(1,1) = 1'
End Sub

Để ý (2.2) ở ví dụ trên: ReDim Preserve Arr2(1 To m, 1 To n), chỉ có thể thay đổi kích thước chiều cuối (chiều thứ 2) của mảng Arr2. 

4. Chép trị từ range của bảng tính vào array và gán các phần tử của array xuống range của bảng tính

(Range – Array – Range)

4.1. Range – Array:

Theo hình học giải tích ta có chia ra 1 chiều (đường thẳng), 2 chiều (mặt phẳng), 3 chiều (dạng khối), và n chiều.

Một range trên bảng tính Excel luôn luôn có 2 chiều (row và column), vậy range sẽ thuộc dạng mặt phẳng.

Khi chép giá trị của một range cho mảng (mảng động), VBA dùng một hàm copy. Hàm này mặc định cho kết quả là mảng 2 chiều, row của range tương ứng với chiều thứ nhất của mảng, column tương ứng với chiều thứ hai của mảng.

 

Dim Arr(), Rng As Range 
'Set Rng = Range("A1:E20")'
Arr = Rng.Value

Lưu ý:

– Trường hợp đặc biệt, khi range chỉ gồm 1 cell, VBA tự nhận biết và không dùng hàm copy mảng mà dùng hàm copy giá trị đơn, kết quả trả về là 1 giá trị (không phải mảng).

Do đó, phải bẫy lỗi trường hợp range chỉ gồm 1 cell trước khi copy vào mảng.

Dim Arr(), Rng As Range 
'Set Rng = Range'
If Rng.Count > 1 Then 
Arr = Rng.Value 
End If

Hoặc ta khai báo biến Arr ở dạng Variant, và kiểm tra kiểu dữ liệu của biến Arr sau khi được gán giá trị của range:

Dim Arr As Variant, Rng As Range
'Set Rng = Range("A1")
Arr = Rng.Value
If TypeName(Arr) = "Variant()" Then 'or: If IsArray(Arr) = True Then
    'Your code.'
End If

– Khi kết hợp dùng hàm Application.Transpose() áp dụng vào range chỉ có 1 cột thì kết quả trả về là mảng 1 chiều. Lưu ý: Hàm Transpose sẽ gặp lỗi khi có một phần tử trong mảng có nhiều hơn 255 ký tự.

Dim Arr(), Rng As Range
Set Rng = Sheet1.Range("A2:A30")
If Rng.Count > 1 Then
    Arr = Application.Transpose(Rng.Value)
End If

Ngoài ra, hàm Transopse chuyển mảng 1 chiều thành mảng 2 chiều: Arr2D=Application.Transpose(Arr1D)

– Cận dưới (LBound) của các chiều của mảng luôn bắt đầu từ 1, cho dù không khai báo Option Base 1.

– Không thể copy giá trị của một range vào mảng tĩnh theo cấu trúc Arr = Rng.Value, mà phải dùng vòng lặp để truyền từng giá trị của range vào mảng.

4.2. Array – Range:

Khi cần gán mảng xuống range ta dùng cấu trúc: 

Rng.value = Arr

Trong đó, range có số dòng/ cột tương ứng (bằng hoặc nhỏ hơn) so với kích thước 2 chiều của mảng Arr.

Lưu ý:

– Khi gán mảng 1 chiều xuống range thì range đó chỉ gồm 1 dòng.

Sub ImportArray_1D()
    Dim Arr(), Rng As Range
    Set Rng = Sheet1.Range("A2:A30")
    If Rng.Count > 1 Then
        Arr = Application.Transpose(Rng.Value) 'Arr là mang 1 chiêu'
    End If
    'Gán mang Arr xuông bang tinh'
    Sheet1.Range("B10").Resize(1, UBound(Arr, 1)).Value = Arr
End Sub

– Khi range chỉ định để gán giá trị của 1 mảng xuống mà nó có số dòng/ cột lớn hơn so với kích thước chiều của mảng thì những cells nằm ngoài sẽ trả về #N/A.

Sub ImportArray_2D()
    Dim Arr()
    Arr = Sheet1.Range("A2:B4").Value
    'Gán mang Arr xuông bang tinh, chú ý xem kêt qua #N/A:'
    Sheet1.Range("A15").Resize(UBound(Arr, 1) + 2, UBound(Arr, 2) + 1).Value = Arr
End Sub

5. Ví dụ:

array_lequocthai.com
array_lequocthai.com

Xét ví dụ nhỏ: Điền số thứ tự dạng số nguyên (1-n) vào vùng A2:A1000000.

Function tạo trả về một mảng 2 chiều, chiều thứ nhất có số phần từ bằng số dòng của range, chiều thứ hai có kích thước bằng 1 phần tử.

Function ArrSeries(ByVal Rng As Range) As Variant
    Dim aTmp(), i As Long
    ReDim aTmp(1 To Rng.Rows.Count, 1 To 1)
    For i = 1 To UBound(aTmp, 1)
        aTmp(i, 1) = i
    Next i
    ArrSeries = aTmp
End Function

Sub gọi function ArrSeries() rồi gán giá trị mảng trả về từ function ArrSeries() xuống range:

Sub SetSeries_Array()
    Dim Rng As Range, T As Double
    T = Timer
    Set Rng = Sheet1.Range("A1:A100000")
    Rng.Value = ArrSeries(Rng)
    MsgBox Round(Timer - T, 2) & " giây"    'T=0.12 giây'
End Sub

Sub thực hiện gán số thứ xuống range theo phương thức gán xuống từng cell của range:

Sub SetSeries_Range()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim i As Long, T As Double
    T = Timer
    For i = 1 To 100000
        Sheet1.Range("A1").Offset(i - 1, 0).Value = i
    Next i
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox Round(Timer - T, 2) & " giây"    'T=2.75 giây'
End Sub 

Nhận xét: Tốc độ code khi sử dụng mảng nhanh hơn rất nhiều sử dụng phương thức sử dụng range.

Tải file ví dụ: Array

1...197198199...203Trang 198 của 203

TĂNG TỐC MẠNG KEY 1.1.1.1

TÔI CHỌN VBA EXCEL

CATEGORY

About Lê Quốc Thái

Yep! I am Le Quoc Thai famous as tnfsmith, one among of netizens beloved internet precious, favorite accumulate sharing all my knowledge and experience Excel, PC tips tricks, gadget news during over decades working in banking data analysis. I am founder AI era: aiphogpt.com , ainextbrain.com

Liên hệ: [email protected]|[email protected]|[email protected]

Follow Lê Quốc Thái

© Cared by LeQuocThai.Com - VBA Excel, APK Mode