Nhờ làm bài toán lọc duy nhất để hiểu về Dictionary

[trungvdb]

Nghiên cứu Dictionary thấy mọi người áp dụng tốt quá, tôi đọc lý thuyết cả chiều nay nhưng thấy nó rất trìu tượng. Xin nhờ giúp cho bài toán cụ thể để tôi dễ hình dung hơn:

Lọc duy nhất các giá trị trong cột A thỏa mãn điều kiện lớn hơn 5 (>5) , kết quả hiện ra tại cột B

Rất mong nhận được sự giúp đỡ của mọi người./1

 

[ptm0412]

Không có gì khó hiểu đâu. Dictionary chỉ là công cụ lọc DS duy nhất.
Còn điều kiện thế nào để được đưa vào DS thì lại là chuyện khác.

Thí dụ:
Lọc DS duy nhất thì dùng câu:

If Key <> "" And Not Dic.Exists(Key) Then
Dic1.Add Key, ""

Nếu thêm điều kiện gì đó thì cứ thêm vào:

If Key <> "" [COLOR=#ff0000]And Key > 5 [/COLOR]And  Not Dic.Exists(Key) Then
Dic1.Add Key, ""

 

[trungvdb]

Đọc lý thuyết tôi thấy cú pháp của Dictionary là MyDictionary.Add Key, Item, tôi chưa phân biệt được Key và Item nó khác nhau như thế nào? Tại sao lại phải có thành phần Item kèm theo (thay vì chỉ cần có Key là đủ).

 

[ketxu]

Mình hiểu nôm na thì : Bạn cứ tưởng tượng Key là tên gọi, Item là giá trị trả về của tên gọi tương ứng khi truy xuất Key. Nó như chỉ số mảng vậy
Giả sử danh sách Dictionary Biệt danh trong lớp bạn có dạng (key Item) :

(A "Nguyễn Văn A")
(B "Nguyễn Văn B")
(C "Nguyễn Văn C")
....

thì khi lấy Item có key A, bạn thu được "Nguyễn Văn A"

 

[trungvdb]

Cảm ơn thày Ptm0412, nhờ thày gợi ý tôi đã làm thử ra kết quả, nếu có thể rút gọn hơn rất mong thày và mọi người giúp:

Sub locDic()
Dim Vung, Mg(), Arr(), i As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set Vung = Range([a1], [a65000].End(xlUp))
Arr = Vung.Value
Range("B:B").Clear
For i = 1 To UBound(Arr)
  If Arr(i, 1) > 5 And Not Dic.exists(Arr(i, 1)) Then
      Dic.Add Arr(i, 1), ""
  End If
Next
  Mg = Dic.keys
[b1].Resize(Dic.Count) = Application.WorksheetFunction.Transpose(Mg)
End Sub

Tôi thắc mắc là tại sao Mg, bản chất của nó lại là mảng hàng ngang mà không phải là hàng dọc?

 

[ptm0412]

Không phải bản chất của Mg, mà là bản chất của Dic.Keys và Dic.Items

Bản chất của Dic.Keys và Dic.Items là mảng 1 chiều. Mảng 1 chiều gán xuống sheet sẽ là mảng ngang. Đọc lại bài về mảng 1 chiều, mảng 2 chiều: http://www.giaiphapexcel.com/forum/...về-mảng-trong-VBA-(Array)&p=300090#post300090

 

[ndu96081631]

Cảm ơn thày Ptm0412, nhờ thày gợi ý tôi đã làm thử ra kết quả, nếu có thể rút gọn hơn rất mong thày và mọi người giúp:

Sub locDic()
  Dim Vung, Mg(), Arr(), i As Long, Dic As Object, tmp As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  Set Vung = Range([A1], [A65000].End(xlUp))
  Arr = Vung.Value
  Range("B:B").Clear
  ReDim Mg(1 To UBound(Arr, 1), 1 To 1)
  For i = 1 To UBound(Arr)
    tmp = 0
    tmp = CDbl(Arr(i, 1))
    If tmp > 5 Then
      If Not Dic.Exists(Arr(i, 1)) Then
        Dic.Add Arr(i, 1), ""
        Mg(Dic.Count, 1) = Arr(i, 1)
      End If
    End If
  Next
  Range("B1").Resize(Dic.Count) = Mg
End Sub

Tôi thắc mắc là tại sao Mg, bản chất của nó lại là mảng hàng ngang mà không phải là hàng dọc?

Vì Mg = Dic.Keys
Mà Dic.Keys và Dic.Items luôn là mảng 1 chiều...
Cũng vì thế mà bạn phải dùng Transpose để xoay mảng 90 độ khi gán xuống sheet. Tuy nhiên điều này không được khuyên dùng trong lập trình VBA (Transpose sẽ gây lỗi với dữ liệu lớn)
Vậy ta nên dùng luôn mảng dọc (hay nói chính xác hơn là mảng 2 chiều)
Code như sau:

Sub locDic()
  Dim Vung, Mg(), Arr(), i As Long, Dic As Object, tmp As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  Set Vung = Range([A1], [A65000].End(xlUp))
  Arr = Vung.Value
  Range("B:B").Clear
  ReDim Mg(1 To UBound(Arr, 1), 1 To 1)
  For i = 1 To UBound(Arr)
    tmp = Val(Arr(i, 1))
    If tmp > 5 Then
      If Not Dic.Exists(Arr(i, 1)) Then
        Dic.Add Arr(i, 1), ""
        Mg(Dic.Count, 1) = Arr(i, 1)
      End If
    End If
  Next
  Range("B1").Resize(Dic.Count) = Mg
End Sub

Lưu ý: Phòng lỗi xuất hiện (chẳng hạn 1 vài cell trong cột A không phải là Number)

 

[trungvdb]

Sao tôi thử sửa Code của thày Ndu thành

Sub locDic()
  Dim Vung, Mg(), Arr(), i As Long, Dic As Object, tmp As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  Set Vung = Range([A1], [A65000].End(xlUp))
  Arr = Vung.Value
  Range("B:B").Clear
  ReDim Mg(1 To UBound(Arr, 1), 1 To 1)
  For i = 1 To UBound(Arr)
    tmp = Val(Arr(i, 1))
    If tmp > 5 Then
      If Not Dic.Exists(Arr(i, 1)) Then
        Dic.Add Arr(i, 1), ""
        Mg(Dic.Count, 1) = Arr(i, 1)
        Mg(Dic.Count, 2) = Arr(i, 1)
      End If
    End If
  Next
  Range("B1").Resize(Dic.Count, 2) = Mg
End Sub

thì kết quả điền được ra cả 2 cột B và C nhỉ? Bởi theo như chủ quan tôi nghĩ ReDim Mg(1 To UBound(Arr, 1), 1 To 1) tức là nó chỉ có nhiều hàng, 1 cột thì tại sao khi thực thi Mg(Dic.Count, 2) = Arr(i, 1) lại không lỗi?

 

[ndu96081631]

Sao tôi thử sửa Code của thày Ndu thành

Sub locDic()
  Dim Vung, Mg(), Arr(), i As Long, Dic As Object, tmp As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  Set Vung = Range([A1], [A65000].End(xlUp))
  Arr = Vung.Value
  Range("B:B").Clear
  ReDim Mg(1 To UBound(Arr, 1), 1 To 1)
  For i = 1 To UBound(Arr)
    tmp = Val(Arr(i, 1))
    If tmp > 5 Then
      If Not Dic.Exists(Arr(i, 1)) Then
        Dic.Add Arr(i, 1), ""
        Mg(Dic.Count, 1) = Arr(i, 1)
        Mg(Dic.Count, 2) = Arr(i, 1)
      End If
    End If
  Next
  Range("B1").Resize(Dic.Count, 2) = Mg
End Sub

thì kết quả điền được ra cả 2 cột B và C nhỉ? Bởi theo như chủ quan tôi nghĩ ReDim Mg(1 To UBound(Arr, 1), 1 To 1) tức là nó chỉ có nhiều hàng, 1 cột thì tại sao khi thực thi Mg(Dic.Count, 2) = Arr(i, 1) lại không lỗi?

Thì bạn hãy xóa bỏ dòng On Error Resume Next ở đầu code rồi thí nghiệm lại sẽ biết liền
Bởi vậy mới nói: Chỉ dùng On Error Resume Next khi ta biết chắc lỗi nào đó ta cần vượt qua, hoặc giả chỉ đặt dòng On Error Resume Next trên đầu code để phòng ngừa mà thôi... Đương nhiên trong lúc đang thí nghiệm thì phải bỏ dòng bẫy lỗi này (mới biết lỗi ở đâu lòi ra chứ)
Ẹc... Ẹc...