- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,719
- Giới tính
- Nam
Đối tương Collection không mới mẻ gì với diễn đàn ta, nhưng nó không phổ biến bằng Dictionary, vì thế tôi mạn phép giới thiệu lại để mọi người có nhiều phương pháp lọc duy nhất hơn.
Như các bạn đã biết đối tượng Dictionary để lọc duy nhất, thì Collection vẫn có thể thực hiện được các chức năng tương tự như thế.
Collection cũng có các thuộc tính Add, Count, Item, Remove
Lưu ý: Key của nó luôn luôn là dạng chuỗi nên khi Add key phải lồng hàm CStr này vào nhé!
Để dễ hình dung, ta có các thủ tục sau theo dữ liệu của một file:
1) Không dùng hàm tự tạo để kiểm tra sự tồn tại của Key (Nó khác với Dictionary không có thuộc tính Exists):
2) Sử dụng hàm tự tạo để kiểm tra Key tồn tại:
Thủ tục dùng hàm Exists:
Các bạn xem file và đánh giá nhé!
Như các bạn đã biết đối tượng Dictionary để lọc duy nhất, thì Collection vẫn có thể thực hiện được các chức năng tương tự như thế.
Collection cũng có các thuộc tính Add, Count, Item, Remove
Lưu ý: Key của nó luôn luôn là dạng chuỗi nên khi Add key phải lồng hàm CStr này vào nhé!
Để dễ hình dung, ta có các thủ tục sau theo dữ liệu của một file:
1) Không dùng hàm tự tạo để kiểm tra sự tồn tại của Key (Nó khác với Dictionary không có thuộc tính Exists):
PHP:
Sub TestCollection1()
On Error Resume Next
Dim arrData, arrResult
Dim objCollect As New Collection
Dim lngCheck As Long, e As Long, m As Long, n As Long, r As Long, u As Long
e = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
arrData = Sheet1.Range("A2:B" & e).Value
u = UBound(arrData)
ReDim arrResult(1 To u, 1 To 2)
For r = 1 To u
lngCheck = VarType(objCollect.Item(arrData(r, 1)))
If Err.Number <> 0 Then
Err.Clear
n = n + 1
objCollect.Add n, CStr(arrData(r, 1))
arrResult(n, 1) = arrData(r, 1)
arrResult(n, 2) = arrData(r, 2)
Else
m = objCollect.Item(arrData(r, 1))
arrResult(m, 2) = arrResult(m, 2) + arrData(r, 2)
End If
Next
Sheet1.Range("D2:E2").Resize(n).Value = arrResult
End Sub
2) Sử dụng hàm tự tạo để kiểm tra Key tồn tại:
PHP:
Function Exists(ByRef objCollect As Collection, ByVal strKey As String) As Boolean
On Error Resume Next
Dim lngCheck As Long
lngCheck = VarType(objCollect.Item(strKey))
If Err.Number = 0 Then Exists = True
Err.Clear
End Function
Thủ tục dùng hàm Exists:
PHP:
Sub TestCollection2()
Dim arrData, arrResult
Dim objCollect As New Collection
Dim e As Long, m As Long, n As Long, r As Long, u As Long
e = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
arrData = Sheet1.Range("A2:B" & e).Value
u = UBound(arrData)
ReDim arrResult(1 To u, 1 To 2)
For r = 1 To u
If Not Exists(objCollect, arrData(r, 1)) Then
n = n + 1
objCollect.Add n, CStr(arrData(r, 1))
arrResult(n, 1) = arrData(r, 1)
arrResult(n, 2) = arrData(r, 2)
Else
m = objCollect.Item(arrData(r, 1))
arrResult(m, 2) = arrResult(m, 2) + arrData(r, 2)
End If
Next
Sheet1.Range("D2:E2").Resize(n).Value = arrResult
End Sub
Các bạn xem file và đánh giá nhé!