Bài 13. Collection

befaint · 4/9/17

Bài 13. Collection

(Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA)

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

PHP:

Dim myCol As Collection
Set myCol = New Collection

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

PHP:

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ụ:

PHP:

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

PHP:

myCol.Count

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

PHP:

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

PHP:

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ụ:

PHP:

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

PHP:

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ụ:

PHP:

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

3.1. Hàm kiểm tra sự tồn tại của một Key trong collection

PHP:

'// 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

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

PHP:

'// 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

3.3. Sắp xếp A-Z

PHP:

'// 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

3.4. Truyền các Items trong collection vào mảng 2 chiều

PHP:

'// 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

Ví dụ: Áp dụng sort A-Z

PHP:

'// Vi du SortingCollection:'
Sub Vidu_Sort()
Dim myCol As Collection, i As Long, arr()
Set myCol = New Collection
arr = Sheet1.Range("R2:R7").Value
For i = 1 To UBound(arr, 1)
    myCol.Add arr(i, 1)
Next i
'Sort Collection'
SortingCollection myCol, 1, myCol.Count

'Truyen cac items cua collection vao array va gan xuong bang tinh'
Sheet1.Range("S2").Resize(UBound(arr, 1), 1) = CollectionToArray(myCol)
End Sub

------------------------
Nguồn tham khảo:
http://analystcave.com/vba-collection/

befaint · 4/9/17

Ví dụ: Lọc loại trùng và tính tổng số lượng ứng với mã sau khi lọc loại trùng.
Xét vùng dữ liệu 100,000 dòng (xem trong file đính kèm).
Sử dụng Collection và Dictionay để so sánh.
Collection (lưu ý: Sử dụng hàm KeyExists ở trên)
Tham khảo file đính kèm ở ngay bài trên.

PHP:

Sub CollectionFilter()
Dim TT As Double
TT = Timer
Dim myCol As Collection
Set myCol = New Collection
Dim i As Long, lRow As Long, ArrData(), Result(), sKey As String, j As Long
With Sheet1
    lRow = .Range("B" & Rows.Count).End(xlUp).Row
    ArrData = .Range("B2:D" & lRow).Value2
    lRow = UBound(ArrData, 1)
    ReDim Result(1 To lRow, 1 To 4)
    For i = 1 To lRow
        sKey = ArrData(i, 1)
        If sKey <> "" Then
            If KeyExists(myCol, sKey) = False Then
                j = j + 1
                myCol.Add j, sKey
                Result(j, 1) = j
                Result(j, 2) = sKey
                Result(j, 3) = ArrData(i, 2)
                Result(j, 4) = ArrData(i, 3)
            Else
                Result(myCol.Item(sKey), 4) = Result(myCol.Item(sKey), 4) + ArrData(i, 3)
             End If
        End If
    Next i
    If j > 0 Then
        .Range("M2").Resize(100, 4).ClearContents
        .Range("M2").Resize(j, 4) = Result
    End If
End With

MsgBox Timer - TT  '0.203-0.218 giây
End Sub

Dictionary:

PHP:

Sub DictionaryFilter()
Dim TT As Double
TT = Timer

Dim Dic As Object
Dim i As Long, lRow As Long, ArrData(), Result(), sKey As String, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    lRow = .Range("B" & Rows.Count).End(xlUp).Row
    ArrData = .Range("B2:D" & lRow).Value2
    lRow = UBound(ArrData, 1)
    ReDim Result(1 To lRow, 1 To 4)
    For i = 1 To lRow
        sKey = ArrData(i, 1)
        If sKey <> "" Then
            If Not Dic.Exists(sKey) Then
                j = j + 1
                Dic.Add sKey, j
                Result(j, 1) = j
                Result(j, 2) = sKey
                Result(j, 3) = ArrData(i, 2)
                Result(j, 4) = ArrData(i, 3)
            Else
                Result(Dic.Item(sKey), 4) = Result(Dic.Item(sKey), 4) + ArrData(i, 3)
            End If
        End If
    Next i
    If j > 0 Then
        .Range("H2").Resize(100, 4).ClearContents
        .Range("H2").Resize(j, 4) = Result
    End If
End With

MsgBox Timer - TT  '0.26-0.28 giây
End Sub

Vô danh Tiểu tốt · 4/9/17

befaint đã viết:
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.

Nhìn vô cách dùng thì có vẻ collection giống một đối tượng hơn là một cấu trúc dữ liệu. Ngay trong định nghĩa của Microsoft thấy họ cũng không nói đây là một cấu trúc dữ liệu. Còn nếu dựa vào định nghĩa "The VBA Collection is a simple native data structure" của trang mà bạn tham khảo thì cũng không bảo đảm cho lắm vì theo đánh giá nội dung nhiều người đọc cũng chỉ đạt mức 3,5 sao (trung bình khá).

befaint đã viết:

PHP:

Public Function CollectionExists(myCol As Collection, ByVal keyCheck As String) As Boolean
    CollectionExists = False
    On Error GoTo EndFunction
    myCol.Item keyCheck
    CollectionExists = True
EndFunction:
End Function

Cái này có thể viết gọn lại thành

PHP:

Function isExits(cc As Collection, o) As Boolean
    On Error GoTo bye
    cc.Item o
    isExits = True
bye:
End Function

Chúng ta có thể lợi dụng "default value" của VBA để bỏ bớt dòng lệnh cài đặt. Cơ mà chỉ lợi dụng ở phạm vi VBA/VB6 thôi nhé.

PHP:

If Not Dic.Exists(sKey) Then

Nếu đã dùng cú pháp như vậy thì sao lại dùng

PHP:

If CollectionExists(myCol, sKey) = False Then

Sẽ đồng bộ hơn nếu dùng

PHP:

If Not CollectionExists(myCol, sKey) Then

Cơ mà nhanh hơn hay chậm hơn thì không dám bảo đảm nha.

VetMini · 4/9/17

befaint đã viết:
3.1. Hàm kiểm tra sự tồn tại của một Key trong collection

PHP:

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

------------------------
Nguồn tham khảo:
http://analystcave.com/vba-collection/

Nguồn của người ta đặt tên hàm là CollectionContains -> cái Collection này có contains/chứa cái Item ấy
Bạn đặt tên hàm của mình là CollectionExists -> cái Collection này hiện hữu -> ý nghĩa khác hoàn toàn.

contain là một động từ, chia ở ngôi thứ 3 số ít là contains. Nó là loại động từ có chủ từ và túc từ đầy đủ; a contains/chứa b
exist cũng là một động từ, chia ở ngôi thứ 3 số ít là exists. Tuy nhiên nó là loại động từ chỉ có chủ từ: a exists/hiện hữu

<< [05/09/2017 10:35am : dòng này do tôi tự ý xoá để tránh phiền hà cho chủ thớt >>

befaint · 4/9/17

VetMini đã viết:
Nguồn của người ta đặt tên hàm là CollectionContains -> cái Collection này có contains/chứa cái Item ấy
Bạn đặt tên hàm của mình là CollectionExists -> cái Collection này hiện hữu -> ý nghĩa khác hoàn toàn.

contain là một động từ, chia ở ngôi thứ 3 số ít là contains. Nó là loại động từ có chủ từ và túc từ đầy đủ; a contains/chứa b
exist cũng là một động từ, chia ở ngôi thứ 3 số ít là exists. Tuy nhiên nó là loại động từ chỉ có chủ từ: a exists/hiện hữu
Lưu ý: isExists/isExist là từ vô nghĩa. Nếu muốn dùng trong câu thì phải là Exists hoặc Does Exist

Em cảm ơn.
Em sửa lại: KeyExists phù hợp không anh?

VetMini · 5/9/17

befaint đã viết:
Em cảm ơn.
Em sửa lại: KeyExists phù hợp không anh?

Cũng tốt.
(nếu bạn muốn từ tương đương với "Contains" thì có thể dùng "Has Item" hoặc "Has Key". Từ "Holds" tuy đồng nghĩa với "Contains" nhưng trong ngữ cảnh này nó bị hơi khó hiểu)

Ashiya199 · 31/8/20

3.3. Sắp xếp A-Z

PHP:

'// 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

Em đang mới đang học cơ bản, trình độ vẫn rất sơ cấp.
Sau khi đọc bài viết trên, em vẫn chưa hiểu được thuật toán của đoạn code trên của anh befaint.
Em cũng tập viết đoạn code nhỏ như dưới để thử sorting.
-----------------------------------------------------------------------------------------------
Sub Sorting2(ByVal myCol As Collection, ByVal fstIndex As Integer, lstIndex As Integer)
Dim i As Integer, j As Integer
Dim vTemp As Variant

For i = fstIndex To lstIndex
For j = i + 1 To lstIndex
If myCol(i) > myCol(j) Then
vTemp = myCol(i)
myCol.Add myCol(j), after:=i
myCol.Remove i
myCol.Add vTemp, before:=j
myCol.Remove j + 1
End If
Next j
Next i
End Sub
-----------------------------------------------------------------------------------------------
Rất mong được các anh chỉ giúp em
1. Thuật toán code của anh befaint
2. Ưu điểm của thuật toán anh befaint
3. Đoạn code nhỏ của em trên có vấn đề gì không

Thanks!!!!

Ngô Hải Đăng · 22/9/20

Lọc loại trùng theo kiểu Collection.

Mã:

Function LocLoaiTrung(iData As Range) As Collection
    Set LocLoaiTrung = New Collection
    Dim rCell As Range
    On Error Resume Next
    For Each rCell In iData
        LocLoaiTrung.Add rCell, CStr(rCell)
    Next rCell
End Function

Bài 13. Collection

befaint

|||||||||||||

File đính kèm

befaint

|||||||||||||

Vô danh Tiểu tốt

Thành viên tiêu biểu

VetMini

Ăn cùng góc phố

befaint

|||||||||||||

VetMini

Ăn cùng góc phố

Ashiya199

Thành viên mới

Ngô Hải Đăng

Thành viên hoạt động

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng