Bài 11. Dictionary (1 người xem)

befaint · 1/10/17

Bài 11. Dictionary

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

Dictionary (Dic) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), cho phép lưu trữ và truy xuất số lượng lớn Item theo Key duy nhất tương ứng.

1. Khai báo
1.1. Kiểu khai báo sớm
(Có Tooltip khi gọi Dic, 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:

PHP:

Dim Dic As Scripting.Dictionary
Set Dic = New Scripting.Dictionary

1.2. Kiểu khai báo muộn
(Không có Tooltip khi gọi Dic, không cần thiết lập trong Tools/References).
Khai báo trong code:

PHP:

Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")

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

PHP:

Dic.Add Key, Item

Thêm Item (đối tượng) vào Dic, yêu cầu Key của Item phải chưa tồn tại trong Dic.
Key: Nhận dữ liệu là kiểu số hoặc kiểu chuỗi, yêu cầu Key là duy nhất trong Dic.
Item: Nhận kiểu dữ liệu là chuỗi hoặc số, bao gồm cả rỗng. Item có thể là một giá trị đơn hoặc một mảng (Array).
Ví dụ:

PHP:

Sub AddMethod()
    'Dic.Add Key, Item'
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    Dic.Add "KeyB", "Item2"
    Dic.Add "KeyC", ""
    Dic.Add "KeyD", Array(20, 50)
End Sub

2.2. Exists

PHP:

Dic.Exists(Key)

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

PHP:

Sub ExistsMethod()
    'Dic.Exists(Key) '
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    MsgBox Dic.Exists("KeyA")   'True'
End Sub

2.3. Remove

PHP:

Dic.Remove(Key)

Xóa một Item trong Dic theo Key chỉ định. Nếu Key chỉ định chưa tồn tại trong Dic thì sẽ xảy ra lỗi.
Ví dụ:

PHP:

Sub RemoveMethod()
    'Dic.Remove(Key) '
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    Dic.Remove ("KeyA")
    MsgBox Dic.Exists("KeyA")   'False'
End Sub

2.4. RemoveAll

PHP:

Dic.RemoveAll

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

PHP:

Sub RemoveAllMethod()
    'Dic.RemoveAll'
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    Dic.Add "KeyB", 20
    Dic.RemoveAll
    MsgBox Dic.Count    '0'
End Sub

2.5. Items

PHP:

Dic.Items

Trả về một mảng một chiều gồm toàn bộ Items có trong Dic.
Mảng một chiều này luôn có cận dưới bằng 0, dù khai báo Option Base 1
Ví dụ:

PHP:

Sub ItemsMethod()
    'Dic.Items'
    Dim Dic As Object, Arr()
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    Dic.Add "KeyB", 20
    Arr = Dic.Items     'LBound(Arr) = 0'
End Sub

2.6. Keys

PHP:

Dic.Keys

Trả về một mảng một chiều gồm toàn bộ Keys tồn tại trong Dic.
Mảng một chiều này luôn có cận dưới bằng 0, dù khai báo Option Base 1
Ví dụ:

PHP:

Sub KeysMethod()
    'Dic.Keys'
    Dim Dic As Object, Arr()
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    Dic.Add "KeyB", 20
    Arr = Dic.Keys     'LBound(Arr) = 0'
End Sub

3. Thuộc tính
3.1. Item

PHP:

Dic.Item(Key)
'Hoặc:'
Dic(Key)

- Gọi Item theo Key chỉ định. Nếu Key chỉ định chưa tồn tại trong Dic, thì Dic sẽ tự động thêm (Add) Key đó vào, và Item ứng với Key đó là rỗng.
- Thay đổi giá trị của Item theo Key chỉ định. Nếu Key chỉ định chưa tồn tại trong Dic, thì Dic sẽ tự động thêm (Add) key đó vào, và Item ứng với Key đó có giá trị vừa đưa vào.

Ví dụ:

PHP:

Sub ItemProperty()
    'Dic.Item(Key)'
    'Dic(Key)   '
    Dim Dic As Object, x, y, z
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    Dic.Add "KeyB", 20
    x = Dic.Item("KeyA") '10'
    y = Dic("KeyA") '10'
    z = Dic("KeyC")
    Dic("KeyC") = 100
    MsgBox Dic.Item("KeyC") '100'
    MsgBox Dic.Count    '3'
End Sub

3.2. Key

PHP:

Dic.Key(Key) = NewKey

Dùng để thay đổi giá trị mới của một Key chỉ định đã tồn tại trong Dic. Yêu cầu:
- Key chỉ định phải đã tồn tại trong Dic
- Giá trị mới của Key đó phải là duy nhất trong Dic (tức là có thể vẫn là giá trị cũ).
Ví dụ:

PHP:

Sub KeyProperty()
    'Dic.Key(Key)=NewKey'
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.Add "KeyA", 10
    Dic.Key("KeyA") = "KeyB"
End Sub

3.3. Count

PHP:

Dic.Count

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

PHP:

Sub CountProperty()
    'Dic.Count '
    Dim Dic As Object, i As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 5
        Dic.Add "Key" & i, ""
    Next i
    MsgBox Dic.Count    '5'
End Sub

3.4. CompareMode

PHP:

Dic.CompareMode = BinaryCompare
Dic.CompareMode = TextCompare

Thiết lập thuộc tính phân biệt chữ hoa chữ thường cho giá trị của Key.
BinaryCompare: (Giá trị mặc định của Dic) Phân biệt chữ hoa chữ thường
TextCompare: Không phân biệt chữ hoa chữ thường
Lưu ý: Thiết lập CompareMode cho Dic khi Dic rỗng (chưa có item nào trong Dic).
Ví dụ:

PHP:

Sub CompareModeProperty()
    'Dic.CompareMode = vbBinaryCompare'
    'Dic.CompareMode = vbTextCompare '
    Dim Dic As Object, i As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
      .CompareMode = vbBinaryCompare
      '.CompareMode = vbTextCompare '
      .Add "code", "lower"
      .Add "CODE", "UPPER"
    End With
End Sub

befaint · 1/10/17

4. Ứng dụng
- Lọc loại trùng.
- Tạo dãy số ngẫu nhiên không trùng.
- …
4.1. Một số hàm
Hàm lọc loại trùng cột đầu tiên của một Range:

PHP:

'//Loc loai trung mot cot'
Function UniqueColumn1D(ByVal Rng As Range) As Variant
    If Rng.Count = 1 Then UniqueColumn1D = Rng.Value: Exit Function
    Dim Dic As Object, i As Long, arr()
    arr = Rng.Value
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, 1) <> "" And Dic.Exists(arr(i, 1)) = False Then
            Dic.Add arr(i, 1), ""
        End If
    Next i
    UniqueColumn1D = Dic.Keys
End Function

Hàm lọc loại trùng cột đầu tiên cho mảng 2 chiều:

PHP:

'//Loc loai trung mang 2 chieu'
Function UniqueArray(ByVal arr As Variant) As Variant
    If IsArray(arr) = False Then Exit Function
    Dim Dic As Object, i As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, 1) <> "" And Dic.Exists(arr(i, 1)) = False Then
            Dic.Add arr(i, 1), ""
        End If
    Next i
    UniqueArray = Dic.Keys
End Function

- Code trong Module:

PHP:

Sub FilterData()
'Sub loc loai trung theo cot [Code] - côt [B]'
Dim Dic As Object
Dim Rng As Range, i As Long, lRow As Long, ArrData(), Result(), iTmp As String, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
'Gan doi tuong Dictionary vao bien Dic'
With Sheet1
'Xét sheet1'
    lRow = .Range("B" & Rows.Count).End(xlUp).Row
    'Tra ve dong cuoi cung co du lieu thuoc cot [B]'
    ArrData = .Range("B2:D" & lRow).Value2
    'Gan vung du lieu [B2:D & lRow] vao bien mang ArrData'
    lRow = UBound(ArrData, 1)
    'Tra ve kich thuoc chieu thu nhat cua mang ArrData'
    ReDim Result(1 To lRow, 1 To 4)
    'Khai bao cu the so chieu va kich thuoc chieu cho bien mang Result'
    For i = 1 To lRow
    'Xet vong lap bien i chay tu 1 toi lRow
        iTmp = ArrData(i, 1)
        'Gan phan tu (i,1) cua mang ArrData vao bien iTmp
        If iTmp <> "" Then
        'Xet iTmp, neu khac rong thi
            If Not Dic.Exists(iTmp) Then
            'Xet iTmp, neu chua ton tai trong Dic thi
                j = j + 1
                'Tang gia tri cua j len 1 don vi
                Dic.Add iTmp, j
                'Them item co gia tri = j ung voi key = iTmp
                'Truyen ket qua vao bien mang Result:
                Result(j, 1) = j
                Result(j, 2) = iTmp
                Result(j, 3) = ArrData(i, 2)
                Result(j, 4) = ArrData(i, 3)
            Else
            'Nguoc lai: iTmp da ton tai trong Dic thi
                Result(Dic.Item(iTmp), 4) = Result(Dic.Item(iTmp), 4) + ArrData(i, 3)
                'Cong don so luong vao phan tu cua mang Result co chi so (Dic.Item(iTmp), 4)
            End If
        End If
    Next i
    If j > 0 Then
    'Xet j >: Tuc la co ket qua loc
        .Range("H2").Resize(100, 4).ClearContents
        'Xoa du lieu trong vung gan ket qua
        .Range("H2").Resize(j, 4) = Result
        'Gan ket qua xuong bang tinh
    End If
End With
End Sub

bibim2014 · 3/11/17

Hàm lọc loại trùng cột đầu tiên cho mảng 2 chiều:
UniqueArray = Dic.Keys

Em chào anh! Anh cho em hỏi một chút là cấu trúc UniqueArray ngoài bảng tính thì viết như thế nào được ạ?

Son-Thuy · 15/9/19

befaint đã viết:
2.1. Add

PHP:

Dic.Add Key, Item

Cho tui hỏi, cái Item ở đây là gì? các bạn có thể thí dụ cho tôi được không
Cảm ơn các bạn!

VetMini · 15/9/19

Dictionary là từ điển, là bảng tra.
Ta ghi cái Item X vào mục (key) A trong sổ. Lúc cần lục ra, tra theo khóa mục A thì sẽ được Item X.
Nếu lấy ví dụ từ điển thì:
chó (danh): con vật thuộc loài có vú, ...
Key là phần bên trái dấu : và Item là phần bên phải.

batman1 · 15/9/19

Son-Thuy đã viết:
Cho tui hỏi, cái Item ở đây là gì? các bạn có thể thí dụ cho tôi được không
Cảm ơn các bạn!

Ví dụ thì dễ mà. Dictionary vậy thì lấy ví dụ từ điển nhé. Bạn làm từ điển thì sẽ có những từ - từ khóa (key) và bạn gán cho mỗi từ khóa ấy một lời diễn giải, giải nghĩa. Khi người dùng từ điểm của bạn muốn tra nghĩa của một từ (key) thì anh ta sẽ đọc ra nghĩa của từ đó từ từ điển của bạn - dic.item(key).
Nói nôm na thì ta gán cho những từ khóa (key) khác nhau những "cái nào đó" (item)."Cái nào đó" là gì thì tùy nhu cầu của bạn.. Vd. bạn có các mặt hàng: táo, ổi, nho ..., và bạn chỉ muốn nhớ giá của chúng (lập bảng gía) thì tên hàng là key còn giá là item. Nếu bạn có hàng loạt Mã nhân viên và với mỗi Mã bạn muốn ghi nhớ: họ tên, tuổi, địa chỉ, giới tính, tình trạng hôn nhân ... thì Mã là key còn mảng chứa các dữ liệu cá nhân là item - gán cho mỗi Mã một mảng dữ liệu cá nhân.
Thế thôi.

gttrongvn · 16/9/19

Ví dụ vầy cho phức tạp: Bạn hãy tưởng tượng Dictionary là một dãy người đang xếp hàng đợi mua một cái gì đó. Trong đó mỗi người là một cá thể riêng biệt không ai giống ai nên ta sẽ liên tưởng tới Key vì Key trong Dictionary không được phép trùng, mỗi người đang xếp hàng đều mang theo các phiếu giảm giá, những phiếu giảm giá đó chúng có thể không giống nhau hoặc giống nhau (cùng mệnh giá) nên ta sẽ liên tưởng tới Item vì Item có thể trùng. Có người chỉ có 1 phiếu giảm giá (Item tương ứng với 1 giá trị), nhưng cũng có người có nhiều phiếu giảm giá (Item tương ứng với một tập hợp các giá trị hay còn gọi là mảng).
Giờ hãy liên tưởng tới các tình huống xảy ra với hàng đợi đó mà ta sẽ gọi trong Dic là phương thức hay thuộc tính:
Dic.Exists(Key): Kiểm tra xem coi một người nào đó có đang xếp hàng không, nếu có thì trả về giá trị Có(True/False)
Dic.Add Key, Item: Thêm một người mới cầm phiếu giảm giá vào xếp hàng mua đồ, và dĩ nhiên là vào sau thì xếp cuối cùng của hàng đợi rồi.
Dic.Remove(Key): Một người nào đó vì mất kiên nhẫn mà bỏ xếp hàng không mua đồ nữa, người đó rời đi với số phiếu giảm giá trong tay và những người xếp sau sẽ di chuyển lên 1 vị trí của hàng đợi.
Dic.Key(Key) = NewKey: Một người nào đó đang xếp hàng nhưng bận việc nhưng không muốn mất vị trí nên nhờ một người bạn xếp hàng thay, tất nhiên là anh ta sẽ đưa số phiếu giảm giá đang có cho người bạn đó chứ để bạn đó trả tiền mặt thì kì lắm. (Key thay đổi nhưng Item không đổi)
Dic.Keys: Cho biết thông tin những người đang xếp hàng theo thứ tự từ đầu đến cuối hàng đợi (Vì kết quả trả về là một danh sách nên ta phải đưa vào mảng)
Dic.Items: Cho biết số phiếu giảm giá mà mỗi người trong hàng đợi đó đang có theo thứ tự từ đầu đến cuối hàng đợi (Vì kết quả trả về là một danh sách nên ta phải đưa vào mảng)
Dic.count: Cho biết có tất cả bao nhiêu người trong hàng đợi đó. (Kết quả trả về là một con số)
Dic.Item(Key) hoặc Dic(Key): Cho biết số phiếu giảm giá tương ứng với người nào đó trong hàng đợi.( Kết quả trả về có thể là một phiếu giảm giá(1 giá trị) hoặc nhiều phiếu giảm giá(mảng))
Dic.RemoveAll: Hàng hóa hết, hàng đợi đó giải tán.

Về ứng dụng ta có thể giải thích như sau:
Giả sử bạn có bảng tính danh sách các khách hàng nhận được phiếu giảm giá trong đó có bạn như sau:

	A	B	C
1	STT	DANH SACH KHÁCH HÀNG	DANH SÁCH PHIẾU GIẢM GIÁ
2	1	Son-Thuy	Phiếu giảm giá 50.000
3	2	batman1	Phiếu giảm giá 80.000
4	3	Son-Thuy	Phiếu giảm giá 100.000
5	4	gttrongvn	Phiếu giảm giá 80.000
6	5	gttrongvn	Phiếu giảm giá 100.000
7	6	Son-Thuy	Phiếu giảm giá 50.000
8	7	batman1	Phiếu giảm giá 50.000

Yêu cầu: tính xem trong danh sách khách hàng đó mỗi người có bao nhiêu phiếu giảm giá và liệt kê danh sách phiếu giảm giá của mỗi người. Áp dụng lọc loại trùng cách làm sẽ như sau:

Mã:

Sub TinhSoPhieuGiamGia()
    Dim Dic As Object
    Dim Arr, ArrKetQua
    Dim SoDongDic As Long, ViTriKey As Long, DongCuoi As Long, PhieuGiamGia As Long, i As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    DongCuoi = Cells(Rows.Count, "B").End(xlUp).Row
    Arr = Range("A2:C" & DongCuoi).Value
    ReDim ArrKetQua(1 To UBound(Arr, 1), 1 To 3)
    For i = 1 To UBound(Arr, 1)
        If Not Dic.exists(Arr(i, 2)) Then
            SoDongDic = SoDongDic + 1
            PhieuGiamGia = 1
            Dic.Add Arr(i, 2), SoDongDic
            ArrKetQua(SoDongDic, 1) = Arr(i, 2)
            ArrKetQua(SoDongDic, 2) = PhieuGiamGia
            ArrKetQua(SoDongDic, 3) = Arr(i, 3)
        Else
            ViTriKey = Dic.Item(Arr(i, 2))
            ArrKetQua(ViTriKey, 2) = ArrKetQua(ViTriKey, 2) + 1
            ArrKetQua(ViTriKey, 3) = ArrKetQua(ViTriKey, 3) & ", " & Arr(i, 3)
        End If
    Next i
    Range("H2").Resize(SoDongDic, 3).Value = ArrKetQua
    Set Dic = Nothing
End Sub

VetMini · 16/9/19

gttrongvn đã viết:
Ví dụ vầy cho phức tạp: ...
...
Về ứng dụng ta có thể giải thích như sau:
Giả sử bạn có bảng tính danh sách các khách hàng nhận được phiếu giảm giá trong đó có bạn như sau:

A B C D
1
STT DANH SACH KHÁCH HÀNG DANH SÁCH PHIẾU GIẢM GIÁ NGÀY HẾT HẠN
2
1
Son-Thuy Phiếu giảm giá 50.000
16/12/2019
3
2
Son-Thuy Phiếu giảm giá 50.000
10/09/2019
4
3
Son-Thuy Phiếu giảm giá 100.000
16/11/2019

Yêu cầu: tính xem trong danh sách khách hàng đó mỗi người có bao nhiêu phiếu giảm giá. Áp dụng lọc loại trùng cách làm sẽ như sau:

Mã:

Sub TinhSoPhieuGiamGia() Dim Dic As Object Dim SoPhieuGiamGia As Long, i As Long Set Dic = CreateObject("Scripting.Dictionary") For i = 2 To 4 'Số dòng bắt đầu từ 2 đến 4 If Not Dic.exists(Range("B" & i).Value) Then 'Nếu hàng đợi chưa có Son-Thuy thì Dic.Add Range("B" & i).Value, 1 'thêm vào hàng đợi,lúc này phiếu giảm giá được tính là 1 phiếu SoPhieuGiamGia = Dic(Range("b" & i).Value) ' Gán giá trị vào biến SoPhieuGiamGia Else SoPhieuGiamGia = SoPhieuGiamGia + 1 'Nếu hàng đợi đã có Son-Thuy thì số phiếu tự động tăng lên 1 End If Next i Debug.Print SoPhieuGiamGia 'Kết quả sẽ là 3 End Sub

Ví dụ dài dòng, và code trên không đạt yêu cầu.
Nếu ta có Son-Thuy, Thuy-Son, Thuy-Son, Son-Thuy thì kết quả nhận được là 3; trong khi cả Son-Thuy lẫn Thuy-Son đều chỉ có 2.

gttrongvn · 16/9/19

VetMini đã viết:
Ví dụ dài dòng, và code trên không đạt yêu cầu.
Nếu ta có Son-Thuy, Thuy-Son, Thuy-Son, Son-Thuy thì kết quả nhận được là 3; trong khi cả Son-Thuy lẫn Thuy-Son đều chỉ có 2.

Con cảm ơn chú, đúng là code sẽ không còn đúng khi phát sinh thêm khách hàng khác, đây là lỗi của con. Ví dụ có thể dài dòng với những người đã quen với Dic, nhưng hi vọng sẽ giúp những người chưa biết có thể dễ hiểu với tiếp cận hơn về Dictionary.

VetMini · 16/9/19

Ví dụ ấy quá chủ quan cho nên hoàn toàn không thích hợp. Vả lại, bạn giải thích thì nhiều mà qua đến ví dụ thì lại thiếu mất một câu căn bản để tóm lược mục đích của code.
Đọc bài trên, người ta không hiểu đây là ví dụ đếm số hay lọc trùng?
Công dụng chính của Dictionary là bảng tra.
Đếm số và lọc trùng chỉ là công dụng phụ của chúng.
Ví dụ của bạn ở trên là đếm số. Phần lớn các bài ứng dụng khác gần đây trong diễn đàn là tổng hợp (consolidate) qua cách lọc trùng.

gttrongvn · 16/9/19

VetMini đã viết:
Ví dụ ấy quá chủ quan cho nên hoàn toàn không thích hợp. Vả lại, bạn giải thích thì nhiều mà qua đến ví dụ thì lại thiếu mất một câu căn bản để tóm lược mục đích của code.
Đọc bài trên, người ta không hiểu đây là ví dụ đếm số hay lọc trùng?
Công dụng chính của Dictionary là bảng tra.
Đếm số và lọc trùng chỉ là công dụng phụ của chúng.
Ví dụ của bạn ở trên là đếm số. Phần lớn các bài ứng dụng khác gần đây trong diễn đàn là tổng hợp (consolidate) qua cách lọc trùng.

Chú nói đúng,ví dụ của con sẽ có thể gây khó hiểu cho người xem, tối về rãnh con sẽ chỉnh lại. Theo quan điểm của con thì công dụng chính của Dic là dùng để lọc loại trùng chứ không phải làm bảng tra, vì con thường sử dụng Dic cho việc lọc loại trùng. Chú có thể cho con một một số ví dụ để biết được ứng dụng chính của Dic là bảng tra mà ta thường xuyên sử dụng trong excel được không?

VetMini · 16/9/19

Ví dụ bảng tra dễ hiểu nhất: thay thế VLookup.

Tôi có một bảng giá hàng 1000 món.
Tôi cần viết code VBA tính toán một số đơn hàng.
Nếu số đơn hàng vài chục cái thì cứ VLookup. Nhưng nếu cỡ vài ngàn và bảng món hàng không được sắp xếp thì VLookup hơi mệt (nếu đã sắp xếp thì VLookup dùng phép tìm nhị phân, tương đối nhanh. Nếu chưa sắp xếp thì nó phải dò tuần tự, tương đối mệt)
Giải pháp hữu hiệu nhất là tôi đưa chi tiết vật tư vào một Dictionary. Mã hàng là Key, và các chi tiết khác nằm trong Item. Tuỳ theo sự rắc rối của chi tiết mà tôi đưa vào Item như thế nào. Có thể tôi dùng một mảng. Có thể là một Type mà tôi đặt ra. Nhưng cũng có thể chỉ là một con số chỉ vị trí của vật tư trong bảng tính.

Khác với Vlookup, Dictionary dùng kỹ thuật bảng băm để chứa cách dò tìm Keys, rất nhanh.

batman1 · 16/9/19

Với dữ liệu như thế và code như thế thì không thể viết

Yêu cầu: tính xem trong danh sách khách hàng đó mỗi người có bao nhiêu phiếu giảm giá.

vì chỉ có Son-Thuy và code chỉ tính cho Son-Thuy, tức 1 người.

Còn nếu thêm dữ liệu "batman1" ở STT 4, 5 để có "mỗi người" thì với code đó không thể đọc ra kết quả cho batman1. Thậm chí không thể đọc thông qua Dic.Item("batman1").

Thay vì dùng SoPhieuGiamGia thì tăng ITEM cho mỗi KEY khi lặp lại thôi. Rồi sau đó muốn đọc ra kết quả cho Son-Thuy hay batman1 hay bất kỳ ai thì đọc ra từ ITEM.

Đã mất công cho ví dụ thì làm cho chuẩn, tức tăng ITEM khi lặp lại KEY. Không mất thêm công vì chỉ tăng ITEM thay cho tăng SoPhieuGiamGia. Với code đã cho thì người ta không được học lọc duy nhất và đếm trùng *** từ A đến Z trọn gói (thiếu tăng ITEM)

***: từ yêu cầu thấy đây là bài toán "Lọc duy nhất và đếm trùng"

gttrongvn · 16/9/19

batman1 đã viết:
Với dữ liệu như thế và code như thế thì không thể viết

vì chỉ có Son-Thuy và code chỉ tính cho Son-Thuy, tức 1 người.

Còn nếu thêm dữ liệu "batman1" ở STT 4, 5 để có "mỗi người" thì với code đó không thể đọc ra kết quả cho batman1. Thậm chí không thể đọc thông qua Dic.Item("batman1").

Thay vì dùng SoPhieuGiamGia thì tăng ITEM cho mỗi KEY khi lặp lại thôi. Rồi sau đó muốn đọc ra kết quả cho Son-Thuy hay batman1 hay bất kỳ ai thì đọc ra từ ITEM.

Đã mất công cho ví dụ thì làm cho chuẩn, tức tăng ITEM khi lặp lại KEY. Không mất thêm công vì chỉ tăng ITEM thay cho tăng SoPhieuGiamGia. Với code đã cho thì người ta không được học lọc duy nhất và đếm trùng từ A đến Z trọn gói (thiếu tăng ITEM)

Chú VetMini có nói rồi anh, để tối về em tìm ví dụ khác, cảm ơn anh

.

batman1 · 16/9/19

gttrongvn đã viết:
Chú VetMini có nói rồi anh, để tối về em tìm ví dụ khác, cảm ơn anh .

Tôi viết lộn. Với dữ liệu tôi đưa thì bạn chỉ đọc được 2 cho batman1 chứ không đọc được cho Son-Thuy, bất luận nó là bao nhiêu, đúng hay sai.

Bác VetMini nói code của bạn sai vì đúng là sai. Tôi nói về vấn đề khác. Chưa biết sai hay đúng nhưng với code đó bạn không thể đọc ra kết quả cho Son-Thuy. Cho ví dụ nhưng tại sao lại dùng SoPhieuGiamGia và tăng SoPhieuGiamGia? Tại sao không tăng ITEM? Rõ ràng trong yêu cầu của bạn có ĐẾM trùng mà lại không tăng ITEM thì khác gì làm từ A tới D? Tự dưng làm code của mình nghèo nàn đi. Ý tôi là cái nghèo nàn này. Ý bác VetMini là code sai. Mỗi người nói về 1 ý. Tôi không thể viết về cái sai vì bác VetMini đã nói rồi.

gttrongvn · 16/9/19

Em đã chỉnh sửa lại ví dụ,em nhờ anh @batman1 với chú @VetMini góp ý.

batman1 · 17/9/19

gttrongvn đã viết:
Em đã chỉnh sửa lại ví dụ,em nhờ anh @batman1 với chú @VetMini góp ý.

1. Nên xóa kết quả cũ. Nếu dữ liệu cũ cho 9 dòng kết quả mà dữ liệu mới chỉ cho 5 dòng kết quả thì 4 dòng ở cuối sẽ gây hiểu lầm.
2. Nên xử lý trường hợp không có dữ liệu. Nếu không có dữ liệu thì code của bạn trả về ... Tự kiểm tra.
3. Nên xử lý trường hợp có dòng trống.
4. Bạn nhập vào Arr cả cột A không dùng đến. Đây chỉ là điểm nhỏ, không quan trọng lắm.
5.

Mã:

PhieuGiamGia = 1
...
ArrKetQua(SoDongDic, 2) = PhieuGiamGia

Dùng PhieuGiamGia để làm gì khi nó LUÔN là 1? Nếu là tôi thì tôi sửa thành

Mã:

...
...
ArrKetQua(SoDongDic, 2) = 1

Bạn đừng buồn nếu tôi góp ý. Tôi làm thế vì bạn đề nghị. Và chuyện sai sót, chưa chuẩn là chuytện thường. Người trong cuộc đôi khi không nhìn thấy những sai sót mà người ngoài cuộc nhìn thấy rất rõ. Bạn dễ dàng nhìn ra thiếu sót của tôi mà tôi lại không nhìn thấy. Và ngược lại. Vì thế chuyện góp ý cho nhau là dễ hiểu.

gttrongvn · 17/9/19

batman1 đã viết:
Bạn đừng buồn nếu tôi góp ý. Tôi làm thế vì bạn đề nghị. Và chuyện sai sót, chưa chuẩn là chuytện thường. Người trong cuộc đôi khi không nhìn thấy những sai sót mà người ngoài cuộc nhìn thấy rất rõ. Bạn dễ dàng nhìn ra thiếu sót của tôi mà tôi lại không nhìn thấy. Và ngược lại. Vì thế chuyện góp ý cho nhau là dễ hiểu.

Không có gì buồn đâu anh, anh góp ý để tốt hơn mà. 1,2,3 em đã code lại. 4 thì chắc không cần chỉnh, chỉ là bảng dữ liệu mẫu thôi. 5 là do em chủ ý khai bao tên biến và viết như vậy để người mới dễ hiểu hơn thôi anh. Anh góp ý file mới tiếp nha.

Son-Thuy · 17/9/19

befaint đã viết:
'//Loc loai trung mang 2 chieu' Function UniqueArray(ByVal arr As Variant) As Variant If IsArray(arr) = False Then Exit Function Dim Dic As Object, i As Long Set Dic = CreateObject("Scripting.Dictionary") For i = LBound(arr, 1) To UBound(arr, 1) If arr(i, 1) <> "" And Dic.Exists(arr(i, 1)) = False Then Dic.Add arr(i, 1), "" End If Next i UniqueArray = Dic.Keys End Function

Các bác cho hỏi bài trên
Tại sao Dic.Add arr(i, 1), "" -> tại sao là ""
Và ở bài 1320 ở chủ đề này https://www.giaiphapexcel.com/diend...ảng-trong-vba-array.46834/page-66#post-935795

Ba Tê đã viết:
Public Sub Gpe() Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Txt As String Set Dic = CreateObject("Scripting.Dictionary") '====================================' sArr = Sheets("OLD").Range("A2", Sheets("OLD").Range("A2").End(xlDown)).Resize(, 5).Value R = UBound(sArr) For I = 1 To R Txt = Space(0) For J = 1 To 5 Txt = Txt & sArr(I, J) Next J Dic.Item(Txt) = "" Next I '====================================' sArr = Sheets("NEW").Range("A2", Sheets("NEW").Range("A2").End(xlDown)).Resize(, 5).Value R = UBound(sArr) ReDim dArr(1 To R, 1 To 1) For I = 1 To R Txt = Space(0) For J = 1 To 5 Txt = Txt & sArr(I, J) Next J If Not Dic.Exists(Txt) Then Dic.Item(Txt) = "" K = K + 1 dArr(K, 1) = Txt End If Next I '====================================' Sheets("Results").Range("E2").Resize(1000).ClearContents Sheets("Results").Range("E2").Resize(K) = dArr Set Dic = Nothing End Sub

Tại sao Dic.Item(Txt) = "" -> tại sao bằng ""
Nhờ các bác giải thích

VetMini · 17/9/19

gttrongvn đã viết:
Không có gì buồn đâu anh, anh góp ý để tốt hơn mà. 1,2,3 em đã code lại. 4 thì chắc không cần chỉnh, chỉ là bảng dữ liệu mẫu thôi. 5 là do em chủ ý khai bao tên biến và viết như vậy để người mới dễ hiểu hơn thôi anh. Anh góp ý file mới tiếp nha.

Bạn có hai cái chủ quan:

1. Ở bài #8, tôi đã phê code (trước khi sửa) của bài #7 là không đạt yêu cầu bởi vì lúc viết code cũng như lúc lập dữ liệu để thử bạn đã mắc phải lỗi chủ quan. Code đã chạy ra kết quả bạn muốn với lý do duy nhất là vì vô hình chung bạn đã lái dữ liệu theo đúng chỗ của nó. Tức là theo tiềm thức, bạn đã có sẵn kết quả trong đầu và tự lập dữ liệu để cho code chạy ra kết quả đó.
(lần sau, nếu sửa code thì bạn nên sửa ở một bài khác. Bạn sửa tại chỗ như thế này rất khó cho người khác trích dẫn ra. Mỗi lần muốn nói về cái phần "trước khi sửa", người ta phải tìm ở đâu?)

2. Cái mệnh đề "người mới dễ hiểu hơn" cũng chủ quan. Thực ra nó còn làm khó hiểu hơn. Tôi mất đến vài phút để suy luận được như bác kia, tức là cái PhieuGiamGia luôn luôn được đặt cho trị số 1 -> nó hoàn toàn thừa.

Son-Thuy đã viết:
Các bác cho hỏi bài trên
Tại sao Dic.Add arr(i, 1), "" -> tại sao là ""
Và ở bài 1320 ở chủ đề này https://www.giaiphapexcel.com/diendan/threads/các-câu-hỏi-về-mảng-trong-vba-array.46834/page-66#post-935795

Tại sao Dic.Item(Txt) = "" -> tại sao bằng ""
Nhờ các bác giải thích

"" là một chuỗi trống. Trước khi đọc tiếp phần giải thích bên dưới, bạn nhắm mắt lại và tưởng tượng: "theo bạn, nếu không phải là chuỗi trống thì nó nên là gì?"

Chú:
Dic.Add arr(i, 1): phương thức Add nạp thêm một vật mới vào Dictionary. Phương thức này cần hai tham số, Key và Item. Ở đây, bài toán là lọc duy nhất cho nên ta chỉ cần Key. Item là cái gì cũng được: "", 0, con chó, cái bàn, ... bất cứ cái gì.
Dic.Item(Txt) = "":

cách viết này hơi phức tạp một chút. Đây là cách gọi phương thức Item() để tìm cái Item có Key là Txt.
Sau khi gọi được rồi thì sửa trị cái Item ấy thành "" (chú ý là sửa trị chứ không phải sửa Key, Key vẫn là Txt)
Với phương thức Item này, nếu Key Txt không có trước trong Dictionary thì nó sẽ tự Add vào (vì vậy mà tôi nói là hơi phức tạp một chút)

batman1 · 17/9/19

gttrongvn đã viết:
Không có gì buồn đâu anh, anh góp ý để tốt hơn mà. 1,2,3 em đã code lại. 4 thì chắc không cần chỉnh, chỉ là bảng dữ liệu mẫu thôi. 5 là do em chủ ý khai bao tên biến và viết như vậy để người mới dễ hiểu hơn thôi anh. Anh góp ý file mới tiếp nha.

Tôi không chạy thử nhưng nhìn code và dữ liệu thì thấy như sau.

Không phải xóa kết quả cũ như thế.
Hiện dữ liệu mới tới dòng 10. Giả sử kết quả cũ tới H15:J15. Code

Mã:

Range("H2:J" & DongCuoi).Clear

là xóa H2:J10. Tức vẫn còn H11:J15.

Kết quả cho dữ liệu mới hiện hành chỉ có 3 dòng. Tức H2:J4. Nhưng do không xóa H11:J15 nên chúng vẫn còn.

nguyenvanlinhab · 6/3/22

gttrongvn đã viết:
Không có gì buồn đâu anh, anh góp ý để tốt hơn mà. 1,2,3 em đã code lại. 4 thì chắc không cần chỉnh, chỉ là bảng dữ liệu mẫu thôi. 5 là do em chủ ý khai bao tên biến và viết như vậy để người mới dễ hiểu hơn thôi anh. Anh góp ý file mới tiếp nha.

code của anh phù hợp với người mới như em mong anh ra thêm nhiều chủ đề ạ

Trần Văn Bình · 24/6/23

befaint đã viết:

4. Ứng dụng
- Lọc loại trùng.
- Tạo dãy số ngẫu nhiên không trùng.
- …
4.1. Một số hàm
Hàm lọc loại trùng cột đầu tiên của một Range:

PHP:

'//Loc loai trung mot cot'
Function UniqueColumn1D(ByVal Rng As Range) As Variant
    If Rng.Count = 1 Then UniqueColumn1D = Rng.Value: Exit Function
    Dim Dic As Object, i As Long, arr()
    arr = Rng.Value
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, 1) <> "" And Dic.Exists(arr(i, 1)) = False Then
            Dic.Add arr(i, 1), ""
        End If
    Next i
    UniqueColumn1D = Dic.Keys
End Function

Hàm lọc loại trùng cột đầu tiên cho mảng 2 chiều:

PHP:

'//Loc loai trung mang 2 chieu'
Function UniqueArray(ByVal arr As Variant) As Variant
    If IsArray(arr) = False Then Exit Function
    Dim Dic As Object, i As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, 1) <> "" And Dic.Exists(arr(i, 1)) = False Then
            Dic.Add arr(i, 1), ""
        End If
    Next i
    UniqueArray = Dic.Keys
End Function

PHP:

Sub FilterData()
'Sub loc loai trung theo cot [Code] - côt [B]'
Dim Dic As Object
Dim Rng As Range, i As Long, lRow As Long, ArrData(), Result(), iTmp As String, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
'Gan doi tuong Dictionary vao bien Dic'
With Sheet1
'Xét sheet1'
    lRow = .Range("B" & Rows.Count).End(xlUp).Row
    'Tra ve dong cuoi cung co du lieu thuoc cot [B]'
    ArrData = .Range("B2:D" & lRow).Value2
    'Gan vung du lieu [B2:D & lRow] vao bien mang ArrData'
    lRow = UBound(ArrData, 1)
    'Tra ve kich thuoc chieu thu nhat cua mang ArrData'
    ReDim Result(1 To lRow, 1 To 4)
    'Khai bao cu the so chieu va kich thuoc chieu cho bien mang Result'
    For i = 1 To lRow
    'Xet vong lap bien i chay tu 1 toi lRow
        iTmp = ArrData(i, 1)
        'Gan phan tu (i,1) cua mang ArrData vao bien iTmp
        If iTmp <> "" Then
        'Xet iTmp, neu khac rong thi
            If Not Dic.Exists(iTmp) Then
            'Xet iTmp, neu chua ton tai trong Dic thi
                j = j + 1
                'Tang gia tri cua j len 1 don vi
                Dic.Add iTmp, j
                'Them item co gia tri = j ung voi key = iTmp
                'Truyen ket qua vao bien mang Result:
                Result(j, 1) = j
                Result(j, 2) = iTmp
                Result(j, 3) = ArrData(i, 2)
                Result(j, 4) = ArrData(i, 3)
            Else
            'Nguoc lai: iTmp da ton tai trong Dic thi
                Result(Dic.Item(iTmp), 4) = Result(Dic.Item(iTmp), 4) + ArrData(i, 3)
                'Cong don so luong vao phan tu cua mang Result co chi so (Dic.Item(iTmp), 4)
            End If
        End If
    Next i
    If j > 0 Then
    'Xet j >: Tuc la co ket qua loc
        .Range("H2").Resize(100, 4).ClearContents
        'Xoa du lieu trong vung gan ket qua
        .Range("H2").Resize(j, 4) = Result
        'Gan ket qua xuong bang tinh
    End If
End With
End Sub

Sub FilterData() em nuốn lấy thêm điều kiện

Result trong khoảng từ ngày đến ngày thì khai báo biến thế nào bạn

	A	B	C	D
1	STT	DANH SACH KHÁCH HÀNG	DANH SÁCH PHIẾU GIẢM GIÁ	NGÀY HẾT HẠN
2	1	Son-Thuy	Phiếu giảm giá 50.000	16/12/2019
3	2	Son-Thuy	Phiếu giảm giá 50.000	10/09/2019
4	3	Son-Thuy	Phiếu giảm giá 100.000	16/11/2019

Bài 11. Dictionary (1 người xem)

Người dùng đang xem chủ đề này

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

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

File đính kèm

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

Thành viên chính thức

Đang đi tìm hòn đá

Thành viên gạo cội

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

File đính kèm

Đang đi tìm hòn đá

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

Đang đi tìm hòn đá

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

Đang đi tìm hòn đá

Thành viên gạo cội

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

Thành viên gạo cội

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

Thành viên gạo cội

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

File đính kèm

Thành viên chính thức

Đang đi tìm hòn đá

Thành viên gạo cội

Thành viên mới

GTVT

Thời gian đếm ngược.