Học Dictionary qua các ví dụ đơn giản! (2 người xem)

[chuot0106]

Thực sự thì mình cũng chưa biết tên topic như vậy có hợp lí không(Nếu chưa hợp lí mong BQT sửa giúp), mình nêu mục đích của topic này luôn.
Bởi vì trên GPE đã có topic về vấn đề này rồi tuy nhiên các topic đó cũng chưa đi sâu lắm về "Dic" bản thân mình rất khó tiếp thu(cá nhân mình thôi). bởi vậy mình xin phép BQT được lập Topic mới này giành cho những người mới chập chững nghiên cứu về "Dic" như mình với mục đích chính như sau:
+ Mong các bạn có kinh nghiệm về "Dic" vào chia sẻ kinh nghiệm của bả n thân về việc học "Dic".
+ Các bạn có kinh nghiệm về "Dic" đưa ra các bài tập từ cơ bản đến đến nâng cao để các thành viên mới thực hành.
+ Các thành viên mới có thể đưa ra các câu hỏi cũng như bài tập liên quan để các thành viên có kinh nghiệm giúp đỡ.
Tất cả các mục đích này dựa trên tinh thần chia sẻ, giao lưu, học hỏi.
Rất mong nhận được sự chia sẻ của các bạn!

 

[chuot0106]

Em xin tự mở hàng topic của mình bằng 1 câu hỏi sau:
Ra kết quả không phải là mục đích chính mà quan trọng hơn em muốn trong code các thầy, các anh chị và các bạn giải thích cho em hiểu ý nghĩa các câu lệnh(thông qua các chú thích). Em cảm ơn!

 

[leonguyenz]

Em xin tự mở hàng topic của mình bằng 1 câu hỏi sau:
Ra kết quả không phải là mục đích chính mà quan trọng hơn em muốn trong code các thầy, các anh chị và các bạn giải thích cho em hiểu ý nghĩa các câu lệnh(thông qua các chú thích). Em cảm ơn!

Tôi tham gia trong tầm hiểu biết của tôi thôi nhé. Giải thích code tôi chèn trong file.
Còn nhiều cao thủ, mong là họ viết cặn kẽ hơn.

Sub BtDic()
Dim Dic As Object, i As Long, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    .[F2:G10].ClearContents
    For i = 1 To .[A2:B10].Rows.Count
        If Not Dic.Exists(.Cells(i + 1, 1).Value) Then
            j = j + 1
            Dic.Add .Cells(i + 1, 1).Value, j
            .Cells(j + 1, 6) = .Cells(i + 1, 1)
            .Cells(j + 1, 7) = .Cells(i + 1, 2)
        End If
    Next i
End With
Set Dic = Nothing
End Sub

 

[chuot0106]

Tôi tham gia trong tầm hiểu biết của tôi thôi nhé. Giải thích code tôi chèn trong file.
Còn nhiều cao thủ, mong là họ viết cặn kẽ hơn.

Sub BtDic()
Dim Dic As Object, i As Long, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    .[F2:G10].ClearContents
    For i = 1 To .[A2:B10].Rows.Count
        If Not Dic.Exists(.Cells(i + 1, 1).Value) Then
            j = j + 1
            Dic.Add .Cells(i + 1, 1).Value, j
            .Cells(j + 1, 6) = .Cells(i + 1, 1)
            .Cells(j + 1, 7) = .Cells(i + 1, 2)
        End If
    Next i
End With
Set Dic = Nothing
End Sub

Cảm ơn Mr.Bum trước tôi nghiên cứu code của bạn đã. Có gì không hiểu tôi lại phiền tiếp!
To Mr.Bum:
Tôi đã xem code của bạn thấy rất dễ hiểu, quả thật được hướng dẫn tỉ mỉ thế này học rất nhanh. Cảm ơn Mr.Bum nhiều!

 

[chuot0106]

Lời giả của em về câu hỏi 1 em đưa ra ở #2, có tham khảo bài của Mr.Bum. Em làm trên mảng. Mong các bạn góp ý!

Option Explicit


Public Sub cauhoi1_dic()
Dim arr(), tam(), dic As Object, i As Long, j As Long
    arr = Sheet1.Range("A2:B10")
    ReDim tam(1 To UBound(arr, 1), 1 To UBound(arr, 2))
Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr, 1)
        If Not dic.exists(arr(i, 1)) Then
            j = j + 1
            dic.Add arr(i, 1), j
            tam(j, 1) = arr(i, 1)
            tam(j, 2) = arr(i, 2)
        End If
    Next i
        Sheet1.Range("F2").Resize(j, UBound(arr, 2)).Value = tam
End Sub

 

[chuot0106]

Em đưa tiếp câu hỏi 2, do em tự nghĩ ra có gì chưa hợp lí mong các bạn góp ý!
Em có 1 bảng thông kê bán hàng của các nhân viên. Giờ em muốn lập bảng thống kê xem trong ba ngày mỗi nhân viên bán được tổng bao nhiêu tiền.

P/S: Mong các bạn giỏi về "Dic" đưa ra các dạng bài tập có thể dùng "Dic" ở mức độ dễ hoặc trung bình để mình và các bạn mới học có thể tự làm. tự nghĩ ra đề hơi khó. Các bạn trải qua rồi sẽ dễ dàng hơn!

 

[chuot0106]

Câu hỏi 3: Lọc dữ liệu trùng trong nhiều cột và đưa ra kết quả ra 1 cột.

P/S: Theo em thì theo mức độ từ khó tới dễ câu này phải là câu 2, còn câu 2 thì là câu 3.

 

[chuot0106]

Không biết câu 2 có làm được bằng "Dic" không nữa? Mong các Thầy vào xem giúp, em tự bịa ra đề. Đau đầu với nó hơn 1 tiếng đồng hồ rồi mà chưa ra thuật toán. Bế tắc quá, mong các thầy cho biết là câu 2 có dùng "Dic" được không ạ? Nếu không em sẽ gỡ File xuống. Mong các thầy cho bọn em 1 số BT ở mức độ dễ và trung bình, quả thật bịa đề khó thật.

 

[chuot0106]

Em đưa tiếp câu hỏi 2, do em tự nghĩ ra có gì chưa hợp lí mong các bạn góp ý!
Em có 1 bảng thông kê bán hàng của các nhân viên. Giờ em muốn lập bảng thống kê xem trong ba ngày mỗi nhân viên bán được tổng bao nhiêu tiền.

P/S: Mong các bạn giỏi về "Dic" đưa ra các dạng bài tập có thể dùng "Dic" ở mức độ dễ hoặc trung bình để mình và các bạn mới học có thể tự làm. tự nghĩ ra đề hơi khó. Các bạn trải qua rồi sẽ dễ dàng hơn!

Bài 2, đánh lươn lẹo 1 tý vậyVẫn dùng Dic)
Dựa vào code của bài 1, lọc ra danh sách không trùng. Sau đó sử dụng công thức SumProduct thế là xong.

 

[Hau151978]

Mình thử làm câu 2, điền cột C thôi, cột B thì như câu 1 rồi. Mình cũng không biết khai báo array tmp() kiểu gì?

Sub cau2()
Dim dic As Object
Dim tmp()
Dim i As Integer
Dim s As String
Set dic = CreateObject("scripting.dictionary")
For i = 1 To 9
If dic.Exists(Cells(i + 1, 1).Text) Then
dic.Item(Cells(i + 1, 1).Text) = dic.Item(Cells(i + 1, 1).Text) + Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
Else
dic.Add Cells(i + 1, 1).Text, Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
End If
Next
tmp = dic.Keys
For i = 0 To dic.Count - 1
s = tmp(i)
Cells(15 + i, 1) = s
Cells(15 + i, 3) = dic.Item(s)
Next
Set dic = Nothing
End Sub

 

[Quang_Hải]

Em xin tự mở hàng topic của mình bằng 1 câu hỏi sau:
Ra kết quả không phải là mục đích chính mà quan trọng hơn em muốn trong code các thầy, các anh chị và các bạn giải thích cho em hiểu ý nghĩa các câu lệnh(thông qua các chú thích). Em cảm ơn!

Code cho câu 1.

Sub abc()
Dim tam(), i As Long
tam = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        If Not .exists(tam(i, 1)) Then
            .Add tam(i, 1), tam(i, 2)
        End If
    Next
    [F2].Resize(.Count) = Application.Transpose(.keys)
    [G2].Resize(.Count) = Application.Transpose(.items)
End With
End Sub

Và code cho câu 2

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
        If Not .exists(tam(i, 1)) Then
            k = k + 1
            .Add tam(i, 1), k
           kq(k, 1) = tam(i, 1)
           kq(k, 2) = tam(i, 2)
           kq(k, 3) = tong
        Else
            n = .Item(tam(i, 1))
            kq(n, 3) = kq(n, 3) + tong
        End If
    Next
End With
[L2].Resize(k, 3) = kq
End Sub

PS: Mình chỉ viết code thôi, chứ cốc có biết chú thích.

 

[chuot0106]

Mình thử làm câu 2, điền cột C thôi, cột B thì như câu 1 rồi. Mình cũng không biết khai báo array tmp() kiểu gì?

Sub cau2()
Dim dic As Object
Dim tmp()
Dim i As Integer
Dim s As String
Set dic = CreateObject("scripting.dictionary")
For i = 1 To 9
If dic.Exists(Cells(i + 1, 1).Text) Then
dic.Item(Cells(i + 1, 1).Text) = dic.Item(Cells(i + 1, 1).Text) + Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
Else
dic.Add Cells(i + 1, 1).Text, Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
End If
Next
tmp = dic.Keys
For i = 0 To dic.Count - 1
s = tmp(i)
Cells(15 + i, 1) = s
Cells(15 + i, 3) = dic.Item(s)
Next
Set dic = Nothing
End Sub

Cảm ơn bạn, kết quả bài bạn chính xác rồ! Nếu có thể bạn chú thích 1 chút về code thì sẽ tốt hơn! Mục tiêu của topic là vậy mà! Mong bạn chia sẻ!

 

[hungpecc1]

* "scripting.Dictionary" là công cụ mạnh để giải quyết bài toán có yếu tố trùng lặp : ví dụ lọc duy nhất,tổng hợp dữ liệu theo một yếu tố nào đó,...........
* Code thì đã có nhiều người viết rồi, thông thường trước câu lệnh if not dic.exists(tmp ) nên thêm một điều kiện kiểm tra chuỗi tmp có phải là ký hiệu rỗng không :

If Len(tmp) then
   If not dic.exists(tmp) then
        dic.add tmp,..
    Else
    ...........
   end if
end if

 

[chuot0106]

* "scripting.Dictionary" là công cụ mạnh để giải quyết bài toán có yếu tố trùng lặp : ví dụ lọc duy nhất,tổng hợp dữ liệu theo một yếu tố nào đó,...........
* Code thì đã có nhiều người viết rồi, thông thường trước câu lệnh if not dic.exists(tmp ) nên thêm một điều kiện kiểm tra chuỗi tmp có phải là ký hiệu rỗng không :

If Len(tmp) then
   If not dic.exists(tmp) then
        dic.add tmp,..
    Else
    ...........
   end if
end if

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

 

[chuot0106]

Code cho câu 1.

Sub abc()
Dim tam(), i As Long
tam = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        If Not .exists(tam(i, 1)) Then
            .Add tam(i, 1), tam(i, 2)
        End If
    Next
    [F2].Resize(.Count) = Application.Transpose(.keys)
    [G2].Resize(.Count) = Application.Transpose(.items)
End With
End Sub

Và code cho câu 2

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
        If Not .exists(tam(i, 1)) Then
            k = k + 1
            .Add tam(i, 1), k
           kq(k, 1) = tam(i, 1)
           kq(k, 2) = tam(i, 2)
           kq(k, 3) = tong
        Else
            n = .Item(tam(i, 1))
            kq(n, 3) = kq(n, 3) + tong
        End If
    Next
End With
[L2].Resize(k, 3) = kq
End Sub

PS: Mình chỉ viết code thôi, chứ cốc có biết chú thích.

Code của anh QuangHai thì quá Ok rồi, nhưng cách viết có vẻ hơi tắt 1 chút hay sao ấy, bởi em thấy lạ lạ. Chắc anh ngại chú thích thôi chứ sao mà anh ko biết! Mong anh chia sẻ chút kinh nghiệm! Cảm ơn anh!

 

[hungpecc1]

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

thì lấy luôn ví dụ là bài tập của bạn thôi :
Mình thử viết code bài 2 như sau :

Sub dem_khuya()
Dim tmpArr, item, tmp, Arr
Dim i&, Sum, n&
'On Error Resume Next
    tmpArr = [A2:E10]
    ReDim Arr(1 To UBound(tmpArr, 1), 1 To 3)
'......................................................
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(tmpArr, 1)
            tmp = tmpArr(i, 1)
            If Len(tmp) Then
                Sum = tmpArr(i, 3) + tmpArr(i, 4) + tmpArr(i, 5)
                If Not .exists(tmp) Then
                    n = n + 1
                    .Add tmp, n
                    Arr(n, 1) = tmp: Arr(n, 2) = tmpArr(i, 2): Arr(n, 3) = Sum
                Else
                    Arr(.item(tmp), 3) = Arr(.item(tmp), 3) + Sum
                End If
            End If
        Next
    End With
'...........................................................................
    [A15:C100].ClearContents
    [A15].Resize(n, 3) = Arr
End Sub

Nếu có dòng code nào khó hiểu, bạn thử ấn F8 để degbug sẽ dễ hiểu hơn !
p/s : viết code xong rồi , xem lại thấy code của mình khá giống với code của anh Quang Hải,^^ <-------- chắc là có chung một trường phái đây

 

[hungpecc1]

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

Nếu bạn đã nắm được cách dùng ( thuộc tính, phương thức ) của Dictionary ,mình thứ đặt ra 3 yêu cầu , bạn làm thử coi :
** Ví dụ 1 :

Vẫn dữ liệu như bài tập 2 đã gửi , yêu cầu :
* thống kê xem có bao nhiêu người tên A trong cột A1: A10 ( đưa kết quả ra hộp thoại msgbox )
** Thống kê những người có cùng Họ và tên + địa chỉ trùng nhau ,và tính tổng số lượng trong 3 ngày : ( đưa toàn bộ kết quả này vào vùng [G:J]
*** Sắp xếp kết quả của yêu cầu ** theo : Tên hoặc theo tổng số lượng giảm dần !

!

 

[siwtom]

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

Kiểm ta kiến thức về Dictionary
Cột A (từ A2) - Tên các thành phố, cột B (từ B2) - tên người. Cột C (từ C2) - kết quả. Nếu Azyz = Ha noi và Bxyz = "he" thì có nghĩa là anh/ chị "he" đã có lần đi du lịch Ha noi.
Hãy liệt kê (từ C2) những thành phố chưa từng đến bởi các vị (các bởi không phân biệt Nam béo hay Nam lác. Cứ Nam là coi là 1) có tên nhập vào C1.
Ví dụ với dữ liệu giả lập
Hà nội, Nga
Hà nội, Tuấn
Huế, Nga
Đà nẵng, Bình
Hà nội, Bình
Huế, Tuấn
Hải Phòng, Bình

C1 = Nga --> C2 = Đà nẵng, C3 = Hải Phòng

 

[siwtom]

p/s : viết code xong rồi , xem lại thấy code của mình khá giống với code của anh Quang Hải,^^ <-------- chắc là có chung một trường phái đây

He he. Trường phái gì. Chẳng qua là bạn mải vật lộn vã mồ hôi với bài Toán nên không để ý là anh Hải tới đứng đằng sau lưng mà thôi

 

[Hau151978]

Cảm ơn bạn, kết quả bài bạn chính xác rồ! Nếu có thể bạn chú thích 1 chút về code thì sẽ tốt hơn! Mục tiêu của topic là vậy mà! Mong bạn chia sẻ!

Trong bài Tổng quan về Dictionary của tác giả kyo có nêu 2 cách khởi tạo dic:
Cách 1: Dim dic as scripting.dictionary
Set dic = new scripting.dictionary
Cách 2: Dim dic as object
Set dic = createobject("scripting.dictionary")
Tác giả có nói cách 1 nhanh hơn còn cách 2 dễ chia sẻ hơn. Như vậy có thể một số bạn luôn dùng cách 2. Tuy nhiên cách 1 ngoài tốc độ nhanh còn có lợi điểm hỗ trợ intellisense nên dễ viết công thức, dễ gỡ rối. Theo mình khi làm bài nên theo cách 1, sau khi ra kết quả sẽ chuyển cách 2.
Để duyệt tất cả phần tử của dic, có thể dùng vòng lặp For Each Next. Mình sửa câu 2 trong bài làm của mình, phần điền cột A, C cho ngắn gọn hơn, không cần khai báo biến mảng nữa:

Sub cau2()
Dim dic As Object
Dim k
Dim i As Integer
Set dic = CreateObject("scripting.dictionary")
For i = 1 To 9
If dic.Exists(Cells(i + 1, 1).Value) Then
dic.Item(Cells(i + 1, 1).Value) = dic.Item(Cells(i + 1, 1).Value) + Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
Else
dic.Add Cells(i + 1, 1).Value, Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
End If
Next
i = 0
For Each k In dic
Cells(15 + i, 1) = k
Cells(15 + i, 3) = dic.Item(k)
i = i + 1
Next
Set dic = Nothing
End Sub

 

[Quang_Hải]

Căn bản về cách sử dụng Dic thì cũng không phức tạp lắm, nhưng ứng dụng biến hóa của Dic trong bài toán cụ thể thì phải tùy khả năng thuật toán của từng người viết code. Chẳng hạn câu 2 cũng có thể viết thế này cũng cho ra kết quả

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        If Not .Exists(tam(i, 1)) Then
            k = k + 1
            .Add tam(i, 1), k
        End If
    Next
    For i = 1 To UBound(tam)
        tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
        If .Exists(tam(i, 1)) Then
            n = .Item(tam(i, 1))
            kq(n, 1) = tam(i, 1)
            kq(n, 2) = tam(i, 2)
            kq(n, 3) = kq(n, 3) + tong
        End If
    Next
End With
[L2].Resize(k, 3) = kq
End Sub

 

[ptm0412]

Căn bản về cách sử dụng Dic thì cũng không phức tạp lắm, nhưng ứng dụng biến hóa của Dic trong bài toán cụ thể thì phải tùy khả năng thuật toán của từng người viết code. Chẳng hạn câu 2 cũng có thể viết thế này cũng cho ra kết quả

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        If Not .Exists(tam(i, 1)) Then
           ...
        End If
    Next
    For i = 1 To UBound(tam)
        ...
        If .Exists(tam(i, 1)) Then
        ...
    Next

End Sub

Code của quanghai chạy 2 vòng lặp y hệt nhau về số lần lặp và 1 cái If (điều kiện chỉ khác 1 chữ not)
Sao không gộp vào 1 vòng lặp với 1 cái Else?
Mà nếu đã có vòng lặp 1, thì tất cả đều đã exist, đâu cần điều kiện if exist trong vòng lặp 2?

 

[Thuyanhanoi]

Nếu bạn đã nắm được cách dùng ( thuộc tính, phương thức ) của Dictionary ,mình thứ đặt ra 3 yêu cầu , bạn làm thử coi :
** Ví dụ 1 :

Vẫn dữ liệu như bài tập 2 đã gửi , yêu cầu :
* thống kê xem có bao nhiêu người tên A trong cột A1: A10 ( đưa kết quả ra hộp thoại msgbox )
** Thống kê những người có cùng Họ và tên + địa chỉ trùng nhau ,và tính tổng số lượng trong 3 ngày : ( đưa toàn bộ kết quả này vào vùng [G:J]
*** Sắp xếp kết quả của yêu cầu ** theo : Tên hoặc theo tổng số lượng giảm dần !

!

- Học mãi cách viết code của thầy Ba Tê mà chưa thạo bởi thời gian và khả năng của mình cũng còn hạn chế!.
- Cũng xin được tham gia bài này mong mọi người chỉ bảo thêm!.

 Public Sub Cauhoi2_Dic()Dim Dic As Object, sArr(), dArr(), I As Long, j As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("A2:E10").Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & sArr(I, 2)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = sArr(I, 2)
        For j = 3 To 5
            dArr(K, 3) = sArr(I, 3) + sArr(I, 4) + sArr(I, 5)
        Next j
    Else
        dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3) + sArr(I, 4) + sArr(I, 5)
    End If
Next I
[A15].Resize(K, 3) = dArr
Set Dic = Nothing
End Sub

 

[siwtom]

- Học mãi cách viết code của thầy Ba Tê mà chưa thạo bởi thời gian và khả năng của mình cũng còn hạn chế!.
- Cũng xin được tham gia bài này mong mọi người chỉ bảo thêm!.

 Public Sub Cauhoi2_Dic()Dim Dic As Object, sArr(), dArr(), I As Long, j As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("A2:E10").Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & sArr(I, 2)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        dArr(K, 1) = sArr(I, 1)
        dArr(K, 2) = sArr(I, 2)
        [COLOR=#ff0000]For j = 3 To 5
            dArr(K, 3) = sArr(I, 3) + sArr(I, 4) + sArr(I, 5)
        Next j[/COLOR]
    Else
        dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3) + sArr(I, 4) + sArr(I, 5)
    End If
Next I
[A15].Resize(K, 3) = dArr
Set Dic = Nothing
End Sub

Chỗ đỏ đỏ là gì vậy? Thao tác hoàn toàn không phụ thuộc vào J có nghĩa là cũng 1 chỗ xyz đóng đinh 3 lần?
Hoặc

dArr(K, 3) = sArr(I, 3) + sArr(I, 4) + sArr(I, 5)

hoặc "khổ hơn tí"

        For j = 3 To 5
            dArr(K, 3) = dArr(K, 3) + sArr(I, j)
        Next j

Ngoài ra nếu dữ liệu có dòng trống thì kết quả chứa dòng trống - thừa. Đây là trong vd. này. Đã từng có code không lường dòng trống nên code "tiếp theo" bị sai.
Vậy phải là

If Tem <> "" Then
    If Not Dic.Exists(Tem) Then
        ...
    Else
        ...
    End If
End If

 

[Thuyanhanoi]

Chỗ đỏ đỏ là gì vậy? Thao tác hoàn toàn không phụ thuộc vào J có nghĩa là cũng 1 chỗ xyz đóng đinh 3 lần?
Hoặc

dArr(K, 3) = sArr(I, 3) + sArr(I, 4) + sArr(I, 5)

hoặc "khổ hơn tí"

        For j = 3 To 5
            dArr(K, 3) = dArr(K, 3) + sArr(I, j)
        Next j

Ngoài ra nếu dữ liệu có dòng trống thì kết quả chứa dòng trống - thừa. Đây là trong vd. này. Đã từng có code không lường dòng trống nên code "tiếp theo" bị sai.
Vậy phải là

If Tem <> "" Then
    If Not Dic.Exists(Tem) Then
        ...
    Else
        ...
    End If
End If

- Cảm ơn Bác siwtom đã chỉ ra cho em những lỗi sai và thêm trường hợp dữ liệu có dòng trống thì kết quả chứa dòng trống - Thừa. Em đã sửa lại Các Bác xem giúp em ạ!.

Public Sub Cauhoi2_Dic()
Dim Dic As Object, sArr(), dArr(), I As Long, j As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("A2:E10").Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1) & sArr(I, 2)
    If Tem <> "" Then
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(I, 2)
            For j = 3 To 5
                dArr(K, 3) = dArr(K, 3) + sArr(I, j)
            Next j
        Else
            dArr(Dic.Item(Tem), 3) = dArr(Dic.Item(Tem), 3) + sArr(I, 3) + sArr(I, 4) + sArr(I, 5)
       End If
    End If
Next I
[A15].Resize(K, 3) = dArr
Set Dic = Nothing
[B]End Sub

[/B]

- Vào GPE tìm hiểu bấy lâu nay, đây là code đầu tiên mà em tham gia!.

 

[chuot0106]

Căn bản về cách sử dụng Dic thì cũng không phức tạp lắm, nhưng ứng dụng biến hóa của Dic trong bài toán cụ thể thì phải tùy khả năng thuật toán của từng người viết code. Chẳng hạn câu 2 cũng có thể viết thế này cũng cho ra kết quả

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
For i = 1 To UBound(tam)
If Not .Exists(tam(i, 1)) Then
k = k + 1
.Add tam(i, 1), k
End If
Next
For i = 1 To UBound(tam)
tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
If .Exists(tam(i, 1)) Then
n = .Item(tam(i, 1))
kq(n, 1) = tam(i, 1)
kq(n, 2) = tam(i, 2)
kq(n, 3) = kq(n, 3) + tong
End If
Next
End With
[L2].Resize(k, 3) = kq
End Sub

Em đọc nhiều bài giải về "Dic" có sử dụng đoạn màu đỏ như ở đoạn code trên, em chưa hiểu ý nghĩa của nó lắm. Rất mong được các thầy và các bạn cho biết ý nghĩa của nó. Nếu có thể giải thích giúp em ý nghĩa của nó trong đoạn code trên của anh QuangHai ạ. Em cảm ơn!

 

[chuot0106]

Em có đọc về thuộc tính Item trong topic "Tổng quan về Scripting..." của tác giả Kyo nhưng em chưa hiểu về thuộc tính Item lắm, mong anh chị và các bạn giải thích và có thể cho ví dụ minh họa thì càng tốt, ví dụ đơn giản thôi ạ!

- Thuộc tính Item: Thuộc tính Item giúp truy xuất hoặc thiết lập giá trị cho một Key nào đó.
PHP Code:
With MyDictionary
.Item("SomeKey") = "gpe"
MsgBox "Giá trị của SomeKey là " & .Item("SomeKey")
End With


Nếu bạn sử dụng thuộc tính Item để đưa một item vào một Key không tồn tại, Dictionary sẽ thêm mới Key không tồn tại đó, đồng thời cũng thêm item vào Key đó luôn. Cũng vậy, nếu bạn truy xuất một item qua một Key không tồn tại, Dictionary sẽ thêm một item rỗng vào chính Key đó. Do đó, sử dụng thuộc tính Item với một Key không tồn tại sẽ không gây ra lỗi.

 

[Hoàng Trọng Nghĩa]

Em có đọc về thuộc tính Item trong topic "Tổng quan về Scripting..." của tác giả Kyo nhưng em chưa hiểu về thuộc tính Item lắm, mong anh chị và các bạn giải thích và có thể cho ví dụ minh họa thì càng tốt, ví dụ đơn giản thôi ạ!

Sub DicItemTest()
    Dim Dic, c As Byte
    Set Dic = CreateObject("Scripting.Dictionary")
    
[COLOR=#008000]    ''Add cho Dic:[/COLOR]
[COLOR=#008000]    ''Voi Key la "Hoang Trong Nghia c" (khong trung)[/COLOR]
[COLOR=#008000]    ''Voi Item la c (trung hay khong van OK)[/COLOR]
    
    For c = 1 To 10
[SIZE=4][B][COLOR=#0000ff]        Dic.Add [/COLOR][COLOR=#800080]"Hoang Trong Nghia " & c[/COLOR][COLOR=#0000ff], [/COLOR][COLOR=#ff0000]c[/COLOR][/B][/SIZE]
    Next
    
[COLOR=#008000]    ''De tra Item cua Key[/COLOR]
[COLOR=#008000]    ''ta lay 1 Key cua no de truy xuat[/COLOR]
[B]    MsgBox Dic.Item([COLOR=#800080]"Hoang Trong Nghia 3"[/COLOR])[/B]
End Sub

Xem ví dụ này là bạn hiểu được tính chất của nó.

 

[chuot0106]

Sub DicItemTest()
    Dim Dic, c As Byte
    Set Dic = CreateObject("Scripting.Dictionary")
    
[COLOR=#008000]    ''Add cho Dic:[/COLOR]
[COLOR=#008000]    ''Voi Key la "Hoang Trong Nghia c" (khong trung)[/COLOR]
[COLOR=#008000]    ''Voi Item la c (trung hay khong van OK)[/COLOR]
    
    For c = 1 To 10
[SIZE=4][B][COLOR=#0000ff]        Dic.Add [/COLOR][COLOR=#800080]"Hoang Trong Nghia " & c[/COLOR][COLOR=#0000ff], [/COLOR][COLOR=#ff0000]c[/COLOR][/B][/SIZE]
    Next
    
[COLOR=#008000]    ''De tra Item cua Key[/COLOR]
[COLOR=#008000]    ''ta lay 1 Key cua no de truy xuat[/COLOR]
[B]    MsgBox Dic.Item([COLOR=#800080]"Hoang Trong Nghia 3"[/COLOR])[/B]
End Sub

Xem ví dụ này là bạn hiểu được tính chất của nó.

Những ví dụ thế này rất dễ hiểu đúng là phù hợp với những người mới tiếp cận như em, cảm ơn anh Nghĩa.

 

[Hau151978]

Em có đọc về thuộc tính Item trong topic "Tổng quan về Scripting..." của tác giả Kyo nhưng em chưa hiểu về thuộc tính Item lắm, mong anh chị và các bạn giải thích và có thể cho ví dụ minh họa thì càng tốt, ví dụ đơn giản thôi ạ!

Có thể coi Dic như một bảng 2 cột. Cột thứ nhất chứa các key, các key trong cột này không trùng nhau, tương tự như cột số thứ tự nhưng key có thể dạng chuỗi, dạng số... Ứng với mỗi key ở cột 1 có 1 item ở cột 2. Thuộc tính .Item(kkk) lấy giá trị của item ứng với key là kkk. Có thể gán keys hoặc items vào mảng để dễ truy xuất hoặc dùng vòng lặp
For each kkk in dic
Msgbox "Giá trị item " & kkk & " là " & dic.item(kkk)
Next

 

[chuot0106]

Mong anh chị tiếp tục giải thích cho em thuộc tính Key với ạ, cũng qua các ví dụ đơn giản luôn cho dễ hiểu ạ! Em cảm ơn!

- Thuộc tính Key: Thuộc tính Key được dùng để thay đổi giá trị của một Key có sẵn. Tuy nhiên, giá trị Key mới phải là giá trị duy nhất trong Dictionary cũng như giá trị Key mà bạn muốn thay đổi cũng phải tồn tại trong Dictionary. Nếu một trong hai điều kiện trên không đúng, chắc chắn lỗi sẽ xảy ra.
PHP Code:
MyDictionary.Key("SomeKey") = "SomeOtherKey"

 

[chuot0106]

Em đọc nhiều bài giải về "Dic" có sử dụng đoạn màu đỏ như ở đoạn code trên, em chưa hiểu ý nghĩa của nó lắm. Rất mong được các thầy và các bạn cho biết ý nghĩa của nó. Nếu có thể giải thích giúp em ý nghĩa của nó trong đoạn code trên của anh QuangHai ạ. Em cảm ơn!

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
For i = 1 To UBound(tam)
If Not .Exists(tam(i, 1)) Then
k = k + 1
.Add tam(i, 1), k
End If
Next
For i = 1 To UBound(tam)
tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
If .Exists(tam(i, 1)) Then
n = .Item(tam(i, 1))
kq(n, 1) = tam(i, 1)
kq(n, 2) = tam(i, 2)
kq(n, 3) = kq(n, 3) + tong
End If
Next
End With
[L2].Resize(k, 3) = kq
End Sub

Quay lại bài này thì chỗ đỏ đỏ chính là tìm vị trí thứ n của khóa tam(i,1) đúng không các bạn?

 

[Hoàng Trọng Nghĩa]

Mong anh chị tiếp tục giải thích cho em thuộc tính Key với ạ, cũng qua các ví dụ đơn giản luôn cho dễ hiểu ạ! Em cảm ơn!

Bạn phải thí nghiệm thì mới biết vấn đề chứ những thứ lặt vặt như thế mà hỏi thì cũng không hay lắm!

Sub DicKeyTest()
    Dim Dic
    Set Dic = CreateObject("Scripting.Dictionary")
    
[COLOR=#008000]    ''Add cho Dic:
    ''Voi Key la "Key: Hoang Trong Nghia" (khong trung)
    ''Voi Item la "Item: gi cung duoc" (trung hay khong van OK)[/COLOR]
    
    Dic.Add "Key: Hoang Trong Nghia", "Item: gi cung duoc"
    
[COLOR=#008000]    ''De tra Item cua Key
    ''ta lay 1 Key cua no de truy xuat[/COLOR]
    MsgBox Dic.Item("Key: Hoang Trong Nghia")
    
[COLOR=#008000]    ''Thay doi Key:
    ''Voi thay doi nay phai la khong trung trong Dic dang san co:[/COLOR]
    Dic.Key("Key: Hoang Trong Nghia") = "Key: Nghia dep trai"
    
[COLOR=#008000]    ''Luc nay Key khong con ton tai "Key: Hoang Trong Nghia" nua
    ''ma da duoc thay the la "Key: Nghia dep trai":[/COLOR]
    
    MsgBox Dic.Item("Key: Nghia dep trai")
[COLOR=#008000]    ''Ket qua Item van la "Item: gi cung duoc"[/COLOR]
End Sub

 

[chuot0106]

Bạn phải thí nghiệm thì mới biết vấn đề chứ những thứ lặt vặt như thế mà hỏi thì cũng không hay lắm!

Sub DicKeyTest()
    Dim Dic
    Set Dic = CreateObject("Scripting.Dictionary")
    
[COLOR=#008000]    ''Add cho Dic:
    ''Voi Key la "Key: Hoang Trong Nghia" (khong trung)
    ''Voi Item la "Item: gi cung duoc" (trung hay khong van OK)[/COLOR]
    
    Dic.Add "Key: Hoang Trong Nghia", "Item: gi cung duoc"
    
[COLOR=#008000]    ''De tra Item cua Key
    ''ta lay 1 Key cua no de truy xuat[/COLOR]
    MsgBox Dic.Item("Key: Hoang Trong Nghia")
    
[COLOR=#008000]    ''Thay doi Key:
    ''Voi thay doi nay phai la khong trung trong Dic dang san co:[/COLOR]
    Dic.Key("Key: Hoang Trong Nghia") = "Key: Nghia dep trai"
    
[COLOR=#008000]    ''Luc nay Key khong con ton tai "Key: Hoang Trong Nghia" nua
    ''ma da duoc thay the la "Key: Nghia dep trai":[/COLOR]
    
    MsgBox Dic.Item("Key: Nghia dep trai")
[COLOR=#008000]    ''Ket qua Item van la "Item: gi cung duoc"[/COLOR]
End Sub

Thực sự là với những người tìm đã có thời gian tìm hiểu lâu về VBA thì tìm hiểu 1 cái mới rất nhanh, còn thực sự bản thân em thì cũng khó thật, mong anh và các bạn giúp đỡ. Cứ qua các ví dụ đơn giản thế này em học sẽ nhanh hơn. Đó cũng chính là mục đích của Topic mà anh!

 

[Hoàng Trọng Nghĩa]

Quay lại bài này thì chỗ đỏ đỏ chính là tìm vị trí thứ n của khóa tam(i,1) đúng không các bạn?

Lợi dụng Key (tam(i,1)) là khóa không trùng và Item (k) nên người viết thường truy xuất vị trí của nó (index) để thực hiện ý đồ của mình. Thực chất để làm điều này (truy xuất index) thì người viết phải đảm bảo hệ số k cũng không trùng luôn.

Với câu hỏi của bạn thì đó chính là câu trả lời luôn rồi đó.

 

[chuot0106]

Các bạn cho tôi hỏi chút, trong doạn code này tôi có thêm 1 câu lệnh để kiểm tra giá trị của biến n.

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
For i = 1 To UBound(tam)
If Not .Exists(tam(i, 1)) Then
k = k + 1
.Add tam(i, 1), k
End If
Next
For i = 1 To UBound(tam)
tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
If .Exists(tam(i, 1)) Then
n = .Item(tam(i, 1))
kq(n, 1) = tam(i, 1)
kq(n, 2) = tam(i, 2)
kq(n, 3) = kq(n, 3) + tong
Msgbox n
End If
Next
End With
[L2].Resize(k, 3) = kq
End Sub

và lần lượt nhận được thông báo giá trị của n là: 2; 3; 1; 3
Nhưng em vẫn chưa hiểu lắm tại sao lại có 4 giá trị này. Đã đọc bài của anh nghĩa nhưng vào bài này vẫn còn mơ hồ quá! Mong anh chị giúp đỡ!

 

[chuot0106]

Có thể coi Dic như một bảng 2 cột. Cột thứ nhất chứa các key, các key trong cột này không trùng nhau, tương tự như cột số thứ tự nhưng key có thể dạng chuỗi, dạng số... Ứng với mỗi key ở cột 1 có 1 item ở cột 2. Thuộc tính .Item(kkk) lấy giá trị của item ứng với key là kkk. Có thể gán keys hoặc items vào mảng để dễ truy xuất hoặc dùng vòng lặp
For each kkk in dic
Msgbox "Giá trị item " & kkk & " là " & dic.item(kkk)
Next

Chỗ đỏ đỏ là lấy giá trị của Item hay lấy vị trí dòng của Item ứng với key là kkk ở trong "Dic" ạ?

 

[VetMini]

Thực sự là với những người tìm đã có thời gian tìm hiểu lâu về VBA thì tìm hiểu 1 cái mới rất nhanh, còn thực sự bản thân em thì cũng khó thật, mong anh và các bạn giúp đỡ. Cứ qua các ví dụ đơn giản thế này em học sẽ nhanh hơn. Đó cũng chính là mục đích của Topic mà anh!

Trên đời có một số người có khả năng ngốn tới đâu tiêu hoá đến đó. Nhưng với số đông còn lại thì ngốn nhiều quá một lúc sẽ bị bội thực.

Mục tiêu của bạn ở chỗ nào? muốn học code, học giải thuật hay học cách dùng công cụ Dictionary của Scripting?

 

[chuot0106]

Trên đời có một số người có khả năng ngốn tới đâu tiêu hoá đến đó. Nhưng với số đông còn lại thì ngốn nhiều quá một lúc sẽ bị bội thực.

Mục tiêu của bạn ở chỗ nào? muốn học code, học giải thuật hay học cách dùng công cụ Dictionary của Scripting?

Em muốn học cách dùng các công cụ của Dictionary của Scripting mong anh chỉ dạy!

 

[chuot0106]

Các bạn cho tôi hỏi chút, trong doạn code này tôi có thêm 1 câu lệnh để kiểm tra giá trị của biến n.

và lần lượt nhận được thông báo giá trị của n là: 2; 3; 1; 3
Nhưng em vẫn chưa hiểu lắm tại sao lại có 4 giá trị này. Đã đọc bài của anh nghĩa nhưng vào bài này vẫn còn mơ hồ quá! Mong anh chị giúp đỡ!

Đã thí nghiệm bằng cách quan sát trên File và đã hiểu được 4 con số kia. Và đã hiểu ý nghĩa của đoạn code đó. Rất vui! Em cảm ơn tất cả các anh chị và các bạn đã tận tình chỉ bảo đặc biệt là anh Nghĩa và ban Hau151978

 

[Hau151978]

Mình tham gia giải bài tập nhằm mục đích học tập. Công việc mới cần thống kê báo cáo nên phải học excel để làm.
Câu lệnh item(kkk) lấy giá trị của item ứng với key là kkk. Nếu bạn muốn lấy thứ tự có thể gán dic.keys hoặc dic.items vào mảng
Vd Dim kkks(), giatri()
kkks=dic.keys
giatri=dic.items

 

[chuot0106]

Quả thật, với topic này mình đã gặt hái được 1 số thành công nho nhỏ, cụ thể bản thân đã tự làm được 1 số bài tập mà mình đã tự ra đề, làm được 1 bài tập của thầy ptm0412 trong topic "Tổng quan về scripting..." của tác giả Kyo mà không nhìn đáp án. Chỉ đói chiếu với đáp án sau khi làm xong và kết quả ra chính xác luôn! Chính vì vậy hôm nay mình mạnh dạn đưa ra 1 câu hỏi nữa(không phải câu đố). Mình không biết câu hỏi này xếp vào mức độ nào nữa, mong các bạn mới học cũng như các thầy tham gia để những người mới như em được học hỏi!

Câu hỏi 4. Trong bảng dữ liệu có nhiều dòng trùng nhau, yêu cầu chỉ dữ lại trong bảng đó 1 dòng thôi, những dòng trùng thì bị xóa hết.
+ TH1: Dữ lại bảng gốc, lọc kết quả ra 1 bảng mới(ở cùng sheet)
+ Trường hợp 2(khó hơn):Kết quả lọc nằm luôn trên bảng dưc liệu gốc.

P/S: Trường hợp 1 có thể bỏ qua, vì rất dễ. Các bạn làm trường hợp 2 thôi nhé!

 

[hungpecc1]

Quả thật, với topic này mình đã gặt hái được 1 số thành công nho nhỏ, cụ thể bản thân đã tự làm được 1 số bài tập mà mình đã tự ra đề, làm được 1 bài tập của thầy ptm0412 trong topic "Tổng quan về scripting..." của tác giả Kyo mà không nhìn đáp án. Chỉ đói chiếu với đáp án sau khi làm xong và kết quả ra chính xác luôn! Chính vì vậy hôm nay mình mạnh dạn đưa ra 1 câu hỏi nữa(không phải câu đố). Mình không biết câu hỏi này xếp vào mức độ nào nữa, mong các bạn mới học cũng như các thầy tham gia để những người mới như em được học hỏi!

Câu hỏi 4. Trong bảng dữ liệu có nhiều dòng trùng nhau, yêu cầu chỉ dữ lại trong bảng đó 1 dòng thôi, những dòng trùng thì bị xóa hết.
+ TH1: Dữ lại bảng gốc, lọc kết quả ra 1 bảng mới(ở cùng sheet)
+ Trường hợp 2(khó hơn):Kết quả lọc nằm luôn trên bảng dưc liệu gốc.

P/S: Trường hợp 1 có thể bỏ qua, vì rất dễ. Các bạn làm trường hợp 2 thôi nhé!

cho mình hỏi thêm , Kết quả lọc nằm trên bảng dữ liệu gốc nghĩa là :
** Xóa bảng dữ liệu cũ đi, chèn bảng kết quả mới không chứa dữ liệu trùng nhau ?
**Hay là tô màu (hight light) những dòng dữ liệu trùng nhau :

 

[siwtom]

Câu hỏi 4. Trong bảng dữ liệu có nhiều dòng trùng nhau, yêu cầu chỉ dữ lại trong bảng đó 1 dòng thôi, những dòng trùng thì bị xóa hết.
+ TH1: Dữ lại bảng gốc, lọc kết quả ra 1 bảng mới(ở cùng sheet)
+ Trường hợp 2(khó hơn):Kết quả lọc nằm luôn trên bảng dưc liệu gốc.

P/S: Trường hợp 1 có thể bỏ qua, vì rất dễ. Các bạn làm trường hợp 2 thôi nhé!

Từ chỗ đỏ đỏ suy ra ý bạn là "bảng mới" và "bảng gốc" là ám chỉ vùng đặt kết quả và vùng dữ liệu nguồn. Tức ở phần 1 thì kết quả đập xuống 1 vùng khác <> vùng dữ liệu còn ở phần 2 thì kết quả đập xuống vùng của bảng gốc. Vậy thì cứ tính kết quả đi - bạn nói là rất dễ thì đã làm được rồi. Trước khi đập kết quả xuống sheet thì XÓA dữ liệu của vùng gốc đi. Cũng rất dễ đúng không?
---------------
Dic hay gì chăng nữa nó chỉ là CÔNG CỤ để thực hiện một "việc" nào đó. Muốn làm được bài Toán bất kỳ thì bước 0 là bước phải viết ra được trên giấy nháp (hoặc trong đầu) các bước cần thực hiện để đi tới kết quả. NGgười ta gọi đó là thuật toán. Không làm được bước 0 thì không làm được bài Toán. Sau khi có được các bước cần làm hay nói nôm na là các việc thì mới là bước chọn CÔNG CỤ để thực hiện việc. Cũng cùng 1 việc có thể dùng những CÔNG CỤ khác nhau. Có khác thì chỉ ở chỗ công cụ này trong trường hợp này ưu thế hơn công cụ kia. Để giết con gà thì công cụ dao gọt hoa quả ưu thế hơn, thuận tiện hơn dao mổ trâu. Nhưng khi cần mổ bò thì dao mổ trâu lại ưu thế hơn dao gọt hoa quả.
Dic chỉ có vài thuộc tính, phương thức. Để biết được những thuộc tính đó có ý nghĩa gì, các phương thức cụ thể làm gì thì chỉ cần đọc help. Để đi từ biết tới hiểu thì cần mục sở thị, tức test vài code. Toàn bộ các việc trên cứ cho là lấy mất 1 ngày. Cái khó và cái học mãi theo năm tháng là luyện tư duy cần thiết để có thể "đẻ" ra một thuật toán.

 

[chuot0106]

cho mình hỏi thêm , Kết quả lọc nằm trên bảng dữ liệu gốc nghĩa là :
** Xóa bảng dữ liệu cũ đi, chèn bảng kết quả mới không chứa dữ liệu trùng nhau ?
**Hay là tô màu (hight light) những dòng dữ liệu trùng nhau :

Tức là xóa các dòng trùng đi, dòng tiêu đề vẫn giữ nguyên.

 

[chuot0106]

Từ chỗ đỏ đỏ suy ra ý bạn là "bảng mới" và "bảng gốc" là ám chỉ vùng đặt kết quả và vùng dữ liệu nguồn. Tức ở phần 1 thì kết quả đập xuống 1 vùng khác <> vùng dữ liệu còn ở phần 2 thì kết quả đập xuống vùng của bảng gốc. Vậy thì cứ tính kết quả đi - bạn nói là rất dễ thì đã làm được rồi. Trước khi đập kết quả xuống sheet thì XÓA dữ liệu của vùng gốc đi. Cũng rất dễ đúng không?

Đúng là quá tuyệt vời. Đúng là chỉ cần có ý tưởng là ok. Em cảm ơn thầy!

 

[Ba Tê]

Quả thật, với topic này mình đã gặt hái được 1 số thành công nho nhỏ, cụ thể bản thân đã tự làm được 1 số bài tập mà mình đã tự ra đề, làm được 1 bài tập của thầy ptm0412 trong topic "Tổng quan về scripting..." của tác giả Kyo mà không nhìn đáp án. Chỉ đói chiếu với đáp án sau khi làm xong và kết quả ra chính xác luôn! Chính vì vậy hôm nay mình mạnh dạn đưa ra 1 câu hỏi nữa(không phải câu đố). Mình không biết câu hỏi này xếp vào mức độ nào nữa, mong các bạn mới học cũng như các thầy tham gia để những người mới như em được học hỏi!

Câu hỏi 4. Trong bảng dữ liệu có nhiều dòng trùng nhau, yêu cầu chỉ dữ lại trong bảng đó 1 dòng thôi, những dòng trùng thì bị xóa hết.
+ TH1: Dữ lại bảng gốc, lọc kết quả ra 1 bảng mới(ở cùng sheet)
+ Trường hợp 2(khó hơn):Kết quả lọc nằm luôn trên bảng dưc liệu gốc.

P/S: Trường hợp 1 có thể bỏ qua, vì rất dễ. Các bạn làm trường hợp 2 thôi nhé!

Nếu bạn muốn vọc code VBA thì bạn nên "thử" với bài này sẽ hay hơn.
http://www.giaiphapexcel.com/forum/...trị-(dạng-chữ)-giống-nhau&p=583439#post583439
Dùng VBA cho tất cả các cột kết quả trong sheet SUMMARY luôn đi.

 

[chuot0106]

Kiểm ta kiến thức về Dictionary
Cột A (từ A2) - Tên các thành phố, cột B (từ B2) - tên người. Cột C (từ C2) - kết quả. Nếu Azyz = Ha noi và Bxyz = "he" thì có nghĩa là anh/ chị "he" đã có lần đi du lịch Ha noi.
Hãy liệt kê (từ C2) những thành phố chưa từng đến bởi các vị (các bởi không phân biệt Nam béo hay Nam lác. Cứ Nam là coi là 1) có tên nhập vào C1.
Ví dụ với dữ liệu giả lập
Hà nội, Nga
Hà nội, Tuấn
Huế, Nga
Đà nẵng, Bình
Hà nội, Bình
Huế, Tuấn
Hải Phòng, Bình

C1 = Nga --> C2 = Đà nẵng, C3 = Hải Phòng

Các bạn cùng tham gia bài tập của thầy Siwtom đi.

 

[ndu96081631]

+ Trường hợp 2(khó hơn):Kết quả lọc nằm luôn trên bảng dưc liệu gốc.

Câu 2 này sẽ khó hơn nếu dữ liệu nguồn có công thức và đòi hỏi sau khi lọc xong thì công thức vẫn được bảo toàn

 

[chuot0106]

Câu 2 này sẽ khó hơn nếu dữ liệu nguồn có công thức và đòi hỏi sau khi lọc xong thì công thức vẫn được bảo toàn

Dạ, đúng là em chưa lường trước được vấn đề này! Vậy bài toán này em nghĩ nó lại khó nên nhiều rồi!

 

[leonguyenz]

Chỉ xóa các dòng trùng trong bảng dữ liệu (không ảnh hưởng đến các cột ngoài vùng dữ liệu) và nếu dữ liệu không có ô nào rỗng (blank) thì có thể dùng code này:
[gpecode=vb]
Sub XoaDong()
Dim Rng As Range, i As Long, Dic As Object, k As Long
Set Rng = Sheet1.Range("A2:F21")
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For i = 1 To Rng.Rows.Count
If Not Dic.Exists(Rng(i, 2).Value) Then
k = k + 1
Dic.Add Rng(i, 2).Value, k
Rng(i, 1) = k
Else
Rng(i, 1).Resize(, 6) = Empty
End If
Next i
If k < Rng.Rows.Count Then
Rng.SpecialCells(4).Delete Shift:=xlUp
End If
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub
[/gpecode]
Còn nếu xóa nguyên dòng thì thì chạy vòng lặp từng Cells cột B và EntireRow.Delete.

 

[hungpecc1]

Dạ, đúng là em chưa lường trước được vấn đề này! Vậy bài toán này em nghĩ nó lại khó nên nhiều rồi!

thử vận may với code này xem thế nào !

Sub delete_Duplicate()
    Dim tmpArr, tmp, strRange$
    Dim i&
    On Error Resume Next
        tmpArr = Range("A2:F21")
        With CreateObject("scripting.dictionary")
            .CompareMode = 1
            For i = 1 To UBound(tmpArr, 1)
                tmp = tmpArr(i, 3)
                If Len(tmp) Then
                    If Not .exists(tmp) Then
                    .Add tmp
                    Else
                        strRange = strRange & "A" & i + 1 & ":F" & i + 1 & ","
                    End If
                End If
            Next
        End With
        Range(Left(strRange, Len(strRange) - 1)).Delete xlShiftUp
End Sub

 

[chuot0106]

thử vận may với code này xem thế nào !

Sub delete_Duplicate()
    Dim tmpArr, tmp, strRange$
    Dim i&
    On Error Resume Next
        tmpArr = Range("A2:F21")
        With CreateObject("scripting.dictionary")
            .CompareMode = 1
            For i = 1 To UBound(tmpArr, 1)
                tmp = tmpArr(i, 3)
                If Len(tmp) Then
                    If Not .exists(tmp) Then
                    .Add tmp
                    Else
                        strRange = strRange & "A" & i + 1 & ":F" & i + 1 & ","
                    End If
                End If
            Next
        End With
        Range(Left(strRange, Len(strRange) - 1)).Delete xlShiftUp
End Sub

Quá tuyệt vời! Tuyệt vời hơn là vẫn giữ được cả công thức!

 

[chuot0106]

Chỉ xóa các dòng trùng trong bảng dữ liệu (không ảnh hưởng đến các cột ngoài vùng dữ liệu) và nếu dữ liệu không có ô nào rỗng (blank) thì có thể dùng code này:
[gpecode=vb]

Sub XoaDong()
Dim Rng As Range, i As Long, Dic As Object, k As Long
Set Rng = Sheet1.Range("A2:F21")
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For i = 1 To Rng.Rows.Count
If Not Dic.Exists(Rng(i, 2).Value) Then
k = k + 1
Dic.Add Rng(i, 2).Value, k
Rng(i, 1) = k
Else
Rng(i, 1).Resize(, 6) = Empty
End If
Next i
If k < Rng.Rows.Count Then
Rng.SpecialCells(4).Delete Shift:=xlUp
End If
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub

Còn nếu xóa nguyên dòng thì thì chạy vòng lặp từng Cells cột B và EntireRow.Delete.

code của leonguyenz cũng tuyệt vời, học thêm được rất nhiều điều từ anh về "Dic". Cảm ơn anh!

 

[thanhlanh]

Sao các bạn không kết hợp Dic và mảng nhỉ?

 

[Quang_Hải]

Chỉ xóa các dòng trùng trong bảng dữ liệu (không ảnh hưởng đến các cột ngoài vùng dữ liệu) và nếu dữ liệu không có ô nào rỗng (blank) thì có thể dùng code này:
[gpecode=vb]
Sub XoaDong()
Dim Rng As Range, i As Long, Dic As Object, k As Long
Set Rng = Sheet1.Range("A2:F21")
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For i = 1 To Rng.Rows.Count
If Not Dic.Exists(Rng(i, 2).Value) Then
k = k + 1
Dic.Add Rng(i, 2).Value, k
Rng(i, 1) = k
Else
Rng(i, 1).Resize(, 6) = Empty
End If
Next i
If k < Rng.Rows.Count Then
Rng.SpecialCells(4).Delete Shift:=xlUp
End If
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub
[/gpecode]
Còn nếu xóa nguyên dòng thì thì chạy vòng lặp từng Cells cột B và EntireRow.Delete.

Bài toán này anh viết chỉ có 2 dòng code thôi, cần chi mà dùng đao to búa lớn thế.

 

[chuot0106]

Bài toán này anh viết chỉ có 2 dòng code thôi, cần chi mà dùng đao to búa lớn thế.

Mong được tham khảo code của anh QuangHai!

 

[hungpecc1]

Bài toán này anh viết chỉ có 2 dòng code thôi, cần chi mà dùng đao to búa lớn thế.

em đoán anh đang đề cập đến advanced filter ,remove duplicate đúng không?

 

[hungpecc1]

Sao các bạn không kết hợp Dic và mảng nhỉ?

em nghĩ :với trường hợp giữ lại công thức trong excel, việc ghi dữ liệu vào mảng sẽ phức tạp hơn việc dùng công cụ delete range !

 

[hungpecc1]

Quá tuyệt vời! Tuyệt vời hơn là vẫn giữ được cả công thức!

???
chia sẻ với bạn cách học Dic của mình :
nếu yêu cầu bài toán có yếu tố trùng lặp ,hay duy nhất thì ta nên nghĩ đến dictionary , việc sử dụng dictionary thông thường theo trình tự sau :
+ xác đinh yếu tố duy nhất,hay tạo ra yếu tố duy nhất không trùng lặp
+ Sử dụng công cụ scripting.dictionary ta sẽ biết được : số lượng + vị trí +.... của yếu tố duy nhất hay trùng lặp
+ Dựa vào các kết quả mà Dic cung cấp để xây dựng thuật toán ,hướng giải quyết yêu cầu ban đầu

 

[chuot0106]

???
chia sẻ với bạn cách học Dic của mình :
nếu yêu cầu bài toán có yếu tố trùng lặp ,hay duy nhất thì ta nên nghĩ đến dictionary , việc sử dụng dictionary thông thường theo trình tự sau :
+ xác đinh yếu tố duy nhất,hay tạo ra yếu tố duy nhất không trùng lặp
+ Sử dụng công cụ scripting.dictionary ta sẽ biết được : số lượng + vị trí +.... của yếu tố duy nhất hay trùng lặp
+ Dựa vào các kết quả mà Dic cung cấp để xây dựng thuật toán ,hướng giải quyết yêu cầu ban đầu

Rất cảm ơn sự chia sẻ của bạn:
+ Cách xác định yếu tố duy nhất để làm Key thì tôi đã biết. Tuy nhiên cách sử dụng các công cụ(Theo tôi nghĩ là các phương thức, thuộc tính) của scripting.dictionary để xác định vị trí thì tôi biết còn xác định số lượng, ... thì tôi chưa rõ lắm. Nếu có thể bạn có thể giúp tôi hiểu sâu hơn về các công cụ của scripting.dictionary được không? Hoặc có tài liệu nào nói về "Dic" thì cho tôi xin với!

 

[Quang_Hải]

em đoán anh đang đề cập đến advanced filter ,remove duplicate đúng không?

Um mình nói đến cái phương thức RemoveDuplicates. Cách này vẫn còn nguyên công thức.

Sub abc()
[A1:F10000].RemoveDuplicates 2, 1
Range([A2], [A65536].End(3)) = [Row(a:A)]
End Sub

 

[Thuyanhanoi]

Um mình nói đến cái phương thức RemoveDuplicates. Cách này vẫn còn nguyên công thức.

Sub abc()
[A1:F10000].RemoveDuplicates 2, 1
Range([A2], [A65536].End(3)) = [Row(a:A)]
End Sub

- Phương thức này hôm nay em mới được biết.
- Anh Hải co thể giải thích rõ hơn chút nữa không a?.

 

[thanhlanh]

em nghĩ :với trường hợp giữ lại công thức trong excel, việc ghi dữ liệu vào mảng sẽ phức tạp hơn việc dùng công cụ delete range !

Không có gì phức tạp:

Sub XoaDong_dungArray()
    Dim Dic As Object, i As Long, j As Long, k As Long, arr()
    arr = Sheet1.Range("A2:F21").FormulaR1C1
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr, 1)
        If Dic.Item(arr(i, 2)) = "" Then
            k = k + 1
            Dic.Item(arr(i, 2)) = k
            arr(k, 1) = k
            For j = 2 To UBound(arr, 2)
                arr(k, j) = arr(i, j)
            Next
        End If
    Next i
    Sheet1.Range("A2").Resize(k, 6).Formula = arr
    Sheet1.Range("A" & k + 2).Resize(UBound(arr, 1) - k, 6).Clear
    Set Dic = Nothing
End Sub

 

[chuot0106]

Um mình nói đến cái phương thức RemoveDuplicates. Cách này vẫn còn nguyên công thức.

Sub abc()
[A1:F10000].RemoveDuplicates 2, 1
Range([A2], [A65536].End(3)) = [Row(a:A)]
End Sub

Để dùng được cái này có cần phải thiết lập gì thêm không anh? Sao em chạy đoạn code này nó báo lỗi run time error '438'.

 

[Kiều Mạnh]

Code cho câu 1.

Sub abc()
Dim tam(), i As Long
tam = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        If Not .exists(tam(i, 1)) Then
            .Add tam(i, 1), tam(i, 2)
        End If
    Next
    [F2].Resize(.Count) = Application.Transpose(.keys)
    [G2].Resize(.Count) = Application.Transpose(.items)
End With
End Sub

Và code cho câu 2

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
        If Not .exists(tam(i, 1)) Then
            k = k + 1
            .Add tam(i, 1), k
           kq(k, 1) = tam(i, 1)
           kq(k, 2) = tam(i, 2)
           kq(k, 3) = tong
        Else
            n = .Item(tam(i, 1))
            kq(n, 3) = kq(n, 3) + tong
        End If
    Next
End With
[L2].Resize(k, 3) = kq
End Sub

PS: Mình chỉ viết code thôi, chứ cốc có biết chú thích.

bài này của anh câu 1 em đọc và hiểu được. còn câu 2 hiểu được chắc còn lai dai quá

 

[chuot0106]

bài này của anh câu 1 em đọc và hiểu được. còn câu 2 hiểu được chắc còn lai dai quá

Với ai đã biết thì rất dễ, còn nếu chưa biết thì hơi mệt đó. tôi nghiên cứu code này của anh Hải mất 2 ngày liền. Nhưng khi đã hiểu được rồi thấy rất vui và còn có thể áp dụng vào bài tập khác nữa đấy! Bạn cứ thử vooc đi!

 

[chuot0106]

Không có gì phức tạp:

Sub XoaDong_dungArray()
    Dim Dic As Object, i As Long, j As Long, k As Long, arr()
    arr = Sheet1.Range("A2:F21").FormulaR1C1
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr, 1)
        If Dic.Item(arr(i, 2)) = "" Then
            k = k + 1
            Dic.Item(arr(i, 2)) = k
            arr(k, 1) = k
            For j = 2 To UBound(arr, 2)
                arr(k, j) = arr(i, j)
            Next
        End If
    Next i
    Sheet1.Range("A2").Resize(k, 6).Formula = arr
    Sheet1.Range("A" & k + 2).Resize(UBound(arr, 1) - k, 6).Clear
    Set Dic = Nothing
End Sub

Anh ThanhLanh có thể giải thích ý nghĩa đoạn code của anh đươc không ạ? Đúng là em không nghĩ bài này dùng mảng được, vậy mà anh...Mong anh chia sẻ!

 

[chuot0106]

Um mình nói đến cái phương thức RemoveDuplicates. Cách này vẫn còn nguyên công thức.

Sub abc()
[A1:F10000].RemoveDuplicates 2, 1
Range([A2], [A65536].End(3)) = [Row(a:A)]
End Sub

Đã tim hiểu, phương thức này dùng cho excell 2007 thì phải. Mà hình như anh QuangHai đã bị "lạc đề" Topic này đang đề cập đến "Dic" cơ!

 

[thanhlanh]

Anh ThanhLanh có thể giải thích ý nghĩa đoạn code của anh đươc không ạ? Đúng là em không nghĩ bài này dùng mảng được, vậy mà anh...Mong anh chia sẻ!

Khi đưa Range vào mảng dùng arr = Sheet1.Range("A2:F21").FormulaR1C1 sẽ có công thức. Ngoài ra, bạn đang nghiên cứu về Dic nên ở trên mình giới thiệu một cách dùng Dic khác để bạn tham khảo.

 

[chuot0106]

Khi đưa Range vào mảng dùng arr = Sheet1.Range("A2:F21").FormulaR1C1 sẽ có công thức. Ngoài ra, bạn đang nghiên cứu về Dic nên ở trên mình giới thiệu một cách dùng Dic khác để bạn tham khảo.

Anh có thể giải thích giúp em ý nghĩa các câu lệnh trong code của anh không ạ? Em chưa hiểu lắm, vì code anh viết rất khác các code e đã gặp!

 

[thanhlanh]

Anh có thể giải thích giúp em ý nghĩa các câu lệnh trong code của anh không ạ? Em chưa hiểu lắm, vì code anh viết rất khác các code e đã gặp!

Sub XoaDong_dungArray()
    Dim Dic As Object, i As Long, j As Long, k As Long, arr()
    arr = Sheet1.Range("A2:F21").FormulaR1C1 ' Đưa Range vào mảng theo tham chiếu RC (nếu có tham chiếu)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr, 1) ' cho i chạy từ dòng đầu đến dòng cuối mảng

        ' Chổ này mới không giống ai nè:
        If Dic.Item(arr(i, 2)) = "" Then ' 
          ' => Nếu khi ta lấy một giá trị của một Key chưa tồn tại trong Dic thì Dic sẽ tự động tạo ra key đó và Item của nó dĩ nhiên còn trống (ở đây là key có tên arr(i, 2), chưa tồn tại)        

            k = k + 1
            Dic.Item(arr(i, 2)) = k ' Gán đại cho Item của Key này một giá trị nào đó
            arr(k, 1) = k   ' Cột đầu là số thứ tự
    
              ' tận dụng mảng đã có, dời tất cả các giá trị của dòng i vảo dòng k bằng vòng lặp sau:
            For j = 2 To UBound(arr, 2)
                arr(k, j) = arr(i, j)
            Next
        End If
    Next i

    Gán các dòng đầu (k dòng) của mảng Arr vào Range (chú ý chỉ lấy K dòng)
    Sheet1.Range("A2").Resize(k, 6).Formula = arr

     nếu có trùng thì  k <> UBound(arr, 1) => dư dòng phải xóa bớt - code ở trên thiếu đk này (các bạn thêm giúp để nếu không có dòng nào trùng sẽ bị lỗi câu lệnh Clear):
    If k <> UBound(arr, 1) then Sheet1.Range("A" & k + 2).Resize(UBound(arr, 1) - k, 6).Clear


    Set Dic = Nothing
End Sub

 

[chuot0106]

Sub XoaDong_dungArray()
    Dim Dic As Object, i As Long, j As Long, k As Long, arr()
    arr = Sheet1.Range("A2:F21").FormulaR1C1 ' Đưa Range vào mảng theo tham chiếu RC (nếu có tham chiếu)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr, 1) ' cho i chạy từ dòng đầu đến dòng cuối mảng

        ' Chổ này mới không giống ai nè:
        If Dic.Item(arr(i, 2)) = "" Then ' 
          ' => Nếu khi ta lấy một giá trị của một Key chưa tồn tại trong Dic thì Dic sẽ tự động tạo ra key đó và Item của nó dĩ nhiên còn trống (ở đây là key có tên arr(i, 2), chưa tồn tại)        

            k = k + 1
            Dic.Item(arr(i, 2)) = k ' Gán đại cho Item của Key này một giá trị nào đó
            arr(k, 1) = k   ' Cột đầu là số thứ tự
    
              ' tận dụng mảng đã có, dời tất cả các giá trị của dòng i vảo dòng k bằng vòng lặp sau:
            For j = 2 To UBound(arr, 2)
                arr(k, j) = arr(i, j)
            Next
        End If
    Next i

    Gán các dòng đầu (k dòng) của mảng Arr vào Range (chú ý chỉ lấy K dòng)
    Sheet1.Range("A2").Resize(k, 6).Formula = arr

     nếu có trùng thì  k <> UBound(arr, 1) => dư dòng phải xóa bớt - code ở trên thiếu đk này (các bạn thêm giúp để nếu không có dòng nào trùng sẽ bị lỗi câu lệnh Clear):
    If k <> UBound(arr, 1) then Sheet1.Range("A" & k + 2).Resize(UBound(arr, 1) - k, 6).Clear


    Set Dic = Nothing
End Sub

Cảm ơn anh nhiều lắm! Anh chú thích rất chi tiết, qua code em học được thêm 2 điều mới, đó là nếu muốn có tham chiếu thì thêm FomulaR1C1 vào. Thứ 2 học được 1 cách dùng khác về "Dic".

 

[chuot0106]

Chỉ xóa các dòng trùng trong bảng dữ liệu (không ảnh hưởng đến các cột ngoài vùng dữ liệu) và nếu dữ liệu không có ô nào rỗng (blank) thì có thể dùng code này:

Sub XoaDong()
Dim Rng As Range, i As Long, Dic As Object, k As Long
Set Rng = Sheet1.Range("A2:F21")
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For i = 1 To Rng.Rows.Count
If Not Dic.Exists(Rng(i, 2).Value) Then
k = k + 1
Dic.Add Rng(i, 2).Value, k
Rng(i, 1) = k
Else
Rng(i, 1).Resize(, 6) = Empty
End If
Next i
If k < Rng.Rows.Count Then
Rng.SpecialCells(4).Delete Shift:=xlUp
End If
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub

Còn nếu xóa nguyên dòng thì thì chạy vòng lặp từng Cells cột B và EntireRow.Delete.

Anh leonguyenz có thể giải thích giúp em ý nghĩa của dòng này được không ạ? Các dòng còn lại em đã hiểu rồi!

Rng.SpecialCells(4).Delete Shift:=xlUp

 

[chuot0106]

Câu hỏi số 5: (Câu hỏi của thầy SiwTom đưa)

Đề bài đã viết rõ trong File.

 

[Quang_Hải]

Thử xóa vầy xem sao

Sub XoaXoaXoa()
    Dim i As Long, j As Long, k As Long, arr()
    arr = Range([A2], [F65536].End(3)).Formula
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(arr, 1)
            If Not .exists(arr(i, 2)) Then
                k = k + 1
                .Add (arr(i, 2)), ""
                arr(k, 1) = k
            Else
                For j = 1 To UBound(arr, 2)
                    arr(i, j) = ""
                Next
            End If
        Next i
    End With
    [A2].Resize(i - 1, 6) = arr
     Range("A2:F" & i).SpecialCells(4).Delete xlShiftUp
End Sub

 

[Hau151978]

Câu hỏi số 5: (Câu hỏi của thầy SiwTom đưa)

Đề bài đã viết rõ trong File.

Đổi gió tý, mình Google được tý SQL, dùng thử xem sao, các bạn sửa giúp nhé xem còn lỗi hay dài quá không? Tạo folder C:\SQL, giải nén 2 file vào đó. Sheet1 là đề bài, mình copy đề sang sheet2 và chỉnh sửa bảng dữ liệu một chút; đặt name data là bảng dữ liệu, name nguoi_loc là tên người cần lọc. Kết quả ở cột D sheet2. Mỗi lần sửa dữ liệu (nhưng không thay đổi số hàng) thì bấm chuột phải vào 1 ô ở kết quả, chọn Refresh data. Nếu thay đổi cả số hàng trong bảng dữ liệu thì phải sửa lại name rồi Refresh. Bấm chuột phải vào ô kết quả, chọn Edit querry để sửa lệnh. Câu lệnh mình dùng là
SELECT DISTINCT data.TP FROM `C:\SQL\Cauhoi5_Dic`.data data WHERE data.TP NOT IN (SELECT data.TP FROM `C:\SQL\Cauhoi5_Dic`.data data INNER JOIN `C:\SQL\Cauhoi5_Dic`.nguoi_loc nguoi_loc ON data.Ten LIKE nguoi_loc.Nguoi & '%')

 

[chuot0106]

Đổi gió tý, mình Google được tý SQL, dùng thử xem sao, các bạn sửa giúp nhé xem còn lỗi hay dài quá không? Tạo folder C:\SQL, giải nén 2 file vào đó. Sheet1 là đề bài, mình copy đề sang sheet2 và chỉnh sửa bảng dữ liệu một chút; đặt name data là bảng dữ liệu, name nguoi_loc là tên người cần lọc. Kết quả ở cột D sheet2. Mỗi lần sửa dữ liệu (nhưng không thay đổi số hàng) thì bấm chuột phải vào 1 ô ở kết quả, chọn Refresh data. Nếu thay đổi cả số hàng trong bảng dữ liệu thì phải sửa lại name rồi Refresh. Bấm chuột phải vào ô kết quả, chọn Edit querry để sửa lệnh. Câu lệnh mình dùng là
SELECT DISTINCT data.TP FROM `C:\SQL\Cauhoi5_Dic`.data data WHERE data.TP NOT IN (SELECT data.TP FROM `C:\SQL\Cauhoi5_Dic`.data data INNER JOIN `C:\SQL\Cauhoi5_Dic`.nguoi_loc nguoi_loc ON data.Ten LIKE nguoi_loc.Nguoi & '%')

Thực ra tất cả những bài toán ví dụ đưa ra ơ đây có nhiều công cụ để giải quyết tuy nhiên chúng ta bám sát chủ đề đó là dùng "Dic", dù sao cũng cảm ơn bạn!

 

[chuot0106]

Nếu hết ngày hôm nay mà không nhận được đáp án câu hỏi 5 ở bài #75thì em mong thầy Siwtom công bố đáp án ạ! Em cũng chưa làm ra do kiến thức về "Dic" cũng chưa nắm hết ạ!

 

[siwtom]

Nếu hết ngày hôm nay mà không nhận được đáp án câu hỏi 5 ở bài #75thì em mong thầy Siwtom công bố đáp án ạ! Em cũng chưa làm ra do kiến thức về "Dic" cũng chưa nắm hết ạ!

Thực ra bạn chỉ bí về thuật toán còn các thuộc tính và phương thức của dic bạn nắm gọn trong lòng bàn tay rồi còn gì.
Chính vì thế tôi mới nhấn mạnh: thuật toán là cái khó và phải học mãi. Rèn luyện tư duy.

Có thể có nhiều hướng, tôi nghĩ đơn giản thế này. Ta duyệt cột A và cho vào dic những tên thành phố. Kết quả phải đạt được là: những tên trong dic mà C1 đã đến thì có Item = 1, những tên chưa đến thì có Item = 0. Sau khi duyệt hết cột A (có thể A, B đập vào mảng trước đó) thì đọc ra những Key mà có Item = 0. Thế thôi.
Tôi không chỉ rõ cách thêm Key vào dic như thế nào vì nếu chỉ ra thì xong bài toán rồi còn gì.

 

[Quang_Hải]

Nếu cho sẵn dữ liệu tại C1 thì mình sẽ xử theo cách này. Thuật toán mình thì tà đạo là chính
Dùng sự kiện change để chạy code này

Sub abc()
Dim nguon(), kq(1 To 10000, 1 To 1), i, k, dk
dk = [C1]
nguon = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nguon)
        If Not .exists(nguon(i, 1)) Then
            .Add nguon(i, 1), ""
            If nguon(i, 2) <> dk Then
                k = k + 1
                kq(k, 1) = nguon(i, 1)
            End If
        End If
    Next
End With
[D2].Resize(UBound(kq)) = kq
End Sub

 

[Quang_Hải]

....................................... đang sửa code

 

[chuot0106]

Nếu muốn lấy hết 1 lần thì thử code này. Mình thì mần được hết nhưng thuật toán code thì tè le.

Sub abc()
Dim nguon(), kq(), i, j, k, tam()
nguon = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nguon)
        If Not .exists(nguon(i, 2)) Then
            .Add nguon(i, 2), ""
        End If
    Next
    tam = .keys
    ReDim kq(1 To 1000, 1 To UBound(tam) + 1)
    For j = 0 To UBound(tam)
        k = 0
        With CreateObject("scripting.dictionary")
            For i = 1 To UBound(nguon)
                If Not .exists(nguon(i, 1)) Then
                    .Add nguon(i, 1), ""
                    If nguon(i, 2) <> tam(j) Then
                        k = k + 1
                        kq(k, j + 1) = nguon(i, 1)
                    End If
                End If
            Next
        End With
    Next
End With
[C1].Resize(, j) = tam
[C2].Resize(k, j) = kq
End Sub

Trong khi chờ thuật toán tối ưu hơn thì những thuật toán tè le như anh quá hữu ích luôn! Đôi khi em mong nghĩ ra những cái tè le như anh mà còn ko được đó.
P/s: Điều quan trọng trước hết là mình phải xử lí vấn đề trước mắt đã.

 

[chuot0106]

Nếu cho sẵn dữ liệu tại C1 thì mình sẽ xử theo cách này. Thuật toán mình thì tà đạo là chính
Dùng sự kiện change để chạy code này

Sub abc()
Dim nguon(), kq(1 To 10000, 1 To 1), i, k, dk
dk = [C1]
nguon = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nguon)
        If Not .exists(nguon(i, 1)) Then
            .Add nguon(i, 1), ""
            If nguon(i, 2) <> dk Then
                k = k + 1
                kq(k, 1) = nguon(i, 1)
            End If
        End If
    Next
End With
[D2].Resize(UBound(kq)) = kq
End Sub

Không phải dữ liệu cho trước ở C1 mà khi nhập vào C1 thì sẽ cho kết quả ở cột C từ C2 trở đi anh ạ!

 

[Quang_Hải]

Không phải dữ liệu cho trước ở C1 mà khi nhập vào C1 thì sẽ cho kết quả ở cột C từ C2 trở đi anh ạ!

Thì cũng giống nhau. Mình đã nói dùng sự kiện change còn gì. Nhưng mà code trên sai bét hết rồi

 

[chuot0106]

Thực ra bạn chỉ bí về thuật toán còn các thuộc tính và phương thức của dic bạn nắm gọn trong lòng bàn tay rồi còn gì.
Chính vì thế tôi mới nhấn mạnh: thuật toán là cái khó và phải học mãi. Rèn luyện tư duy.

Có thể có nhiều hướng, tôi nghĩ đơn giản thế này. Ta duyệt cột A và cho vào dic những tên thành phố. Kết quả phải đạt được là: những tên trong dic mà C1 đã đến thì có Item = 1, những tên chưa đến thì có Item = 0. Sau khi duyệt hết cột A (có thể A, B đập vào mảng trước đó) thì đọc ra những Key mà có Item = 0. Thế thôi.
Tôi không chỉ rõ cách thêm Key vào dic như thế nào vì nếu chỉ ra thì xong bài toán rồi còn gì.

Quả thật đây là bài toán khá hóc búa, thầy đã gợi ý như vậy mã nghĩ mãi từ tối qua tới giờ vẫn chưa ra? Cái khó là không biết chọn Key.

 

[thanhlanh]

Thêm một thuật toán gợi ý cho bạn nữa:
Dùng hai lần lặp cho cùng mảng dữ liệu:
- Vòng lặp thứ nhất, tìm tên các TP mà [C1] đã đi qua đưa vào Dic1
- Vòng lặp thứ hai nếu TP nào chưa có trong Dic1 thì đưa vào Dic2
Danh sách cần tìm sẽ nằm trong Dic2

 

[chuot0106]

Thêm một thuật toán gợi ý cho bạn nữa:
Dùng hai lần lặp cho cùng mảng dữ liệu:
- Vòng lặp thứ nhất, tìm tên các TP mà [C1] đã đi qua đưa vào Dic1
- Vòng lặp thứ hai nếu TP nào chưa có trong Dic1 thì đưa vào Dic2
Danh sách cần tìm sẽ nằm trong Dic2

Thêm 1 kinh nghiệm nữa về dùng Dic, tức là chúng ta có thể khai báo đồng thời 2 biến Dic1 và Dic2 cũng được phải không anh?

 

[thanhlanh]

Wow, Theo mình hiểu, nó là một đối tượng (Object) Dictionary trong VBA, cũng như file trong hệ điều hành thôi, vì vậy bạn tạo ra bao nhiêu cái không được (chỉ sợ tràn bộ nhớ, he he) còn Díc, Dic2 ... chẳng qua là những cái tên.

 

[VetMini]

Thêm 1 kinh nghiệm nữa về dùng Dic, tức là chúng ta có thể khai báo đồng thời 2 biến Dic1 và Dic2 cũng được phải không anh?

Dic có kiểu là object. Mỗi lần kêu hàm CreateObject (nếu có reference thì là lệnh New) thì tạo được 1 object. Dùng một lúc 1 triệu cũng được nếu bộ nhớ cho phép.

Dùng lý thuyết CSDL liên hệ. Lập tất cả 3 dic's
D1 chứa các tên tỉnh
D2 chứa các tên người
D3 chứa các tỉnh mà người đã đi qua, tức là tên tỉnh & tên người (đương nhiên phải cách cái gì đó, ";" chẳng hạn)
(Các Dic's trên đều chỉ dùng key, không dùng item. Chỉ cần một vòng lặp là dựng đủ 3 dic's)
VD muốn tìm tên các tỉnh mà chị A chưa/đã đến thì dùng một vòng lặp duyệt D1, tìm tên tỉnh & ";" & "A" trong D3, nếu có thì là đã nếu không thì là chưa.

Cách này tương đối chậm nhưng khá giản dị khoa học. Đúng với tinh thần CSDL LH, giản dị khoa học nhưng chậm.

Cách thứ hai là cách phản chuẩn của CSDL LH:
D1 có key là tỉnh và item là chuỗi chứa các tên tương ứng
Muôn biết chị A chưa/đã đi qua những tỉnh nào thì duyệt D1, xét tên "A" trong chuỗi item.

 

[Hau151978]

Quả thật đây là bài toán khá hóc búa, thầy đã gợi ý như vậy mã nghĩ mãi từ tối qua tới giờ vẫn chưa ra? Cái khó là không biết chọn Key.

Key là các thành phố mà bạn.

Sub cau5()
Dim r As Range
Dim dic As Scripting.Dictionary
Dim s As String, k As String
Dim i As Integer
Dim j
s = Range("c1").Text
Set dic = New Scripting.Dictionary
Set r = Range("a2", Range("b100").End(xlUp))
For i = 1 To r.Rows.Count
k = r.Cells(i, 1).Text
If Not (dic.Exists(k)) Then dic.Add k, False
If r.Cells(i, 2).Text Like (s & "*") Then dic.Item(k) = True
Next
i = 2
Range("c2:c100").ClearContents
For Each j In dic
If Not (dic.Item(j)) Then
Cells(i, 3) = j
i = i + 1
End If
Next
End Sub

 

[VetMini]

Đi xa mục tiêu đề bài. Xin phép xoá để khỏi làm loãng thớt. Xin lỗi.

 

[Quang_Hải]

Nhất định dùng 1 Dic thử coi có ra kết quả không. Đau đầu quá

Sub abc()
Dim nguon(), kq(), i, j, k, tam()
nguon = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nguon)
        If Not .exists(nguon(i, 2)) Then
            .Add nguon(i, 2), ""
        End If
    Next
    tam = .keys
End With
ReDim kq(1 To 1000, 1 To UBound(tam) + 1)
For j = 0 To UBound(tam)
     With CreateObject("scripting.dictionary")
        k = 0
        For i = 1 To UBound(nguon)
            If nguon(i, 2) = tam(j) Then
                If Not .exists(nguon(i, 1)) Then
                    .Add nguon(i, 1), ""
                End If
            End If
        Next
        For i = 1 To UBound(nguon)
            If nguon(i, 2) <> tam(j) Then
                If Not .exists(nguon(i, 1)) Then
                    .Add nguon(i, 1), ""
                    k = k + 1
                    kq(k, j + 1) = nguon(i, 1)
                End If
            End If
        Next
    End With
Next
[C1].Resize(, j) = tam
[C2].Resize(UBound(kq), j) = kq
End Sub

 

[chuot0106]

Nhất định dùng 1 Dic thử coi có ra kết quả không. Đau đầu quá

Sub abc()
Dim nguon(), kq(), i, j, k, tam()
nguon = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nguon)
        If Not .exists(nguon(i, 2)) Then
            .Add nguon(i, 2), ""
        End If
    Next
    tam = .keys
End With
ReDim kq(1 To 1000, 1 To UBound(tam) + 1)
For j = 0 To UBound(tam)
     With CreateObject("scripting.dictionary")
        k = 0
        For i = 1 To UBound(nguon)
            If nguon(i, 2) = tam(j) Then
                If Not .exists(nguon(i, 1)) Then
                    .Add nguon(i, 1), ""
                End If
            End If
        Next
        For i = 1 To UBound(nguon)
            If nguon(i, 2) <> tam(j) Then
                If Not .exists(nguon(i, 1)) Then
                    .Add nguon(i, 1), ""
                    k = k + 1
                    kq(k, j + 1) = nguon(i, 1)
                End If
            End If
        Next
    End With
Next
[C1].Resize(, j) = tam
[C2].Resize(UBound(kq), j) = kq
End Sub

Anh ơi code này nó thống kê hết cả ra. Em chỉ muốn khi nào nhập vào C1 tên ai đó thì nó mới thống kê thôi thì phải sửa thế nào vậy anh?

 

[Quang_Hải]

Anh ơi code này nó thống kê hết cả ra. Em chỉ muốn khi nào nhập vào C1 tên ai đó thì nó mới thống kê thôi thì phải sửa thế nào vậy anh?

Thử code này coi sao

Sub ABC2()
Dim nguon(), kq(1 To 1000, 1 To 1), i, j, k, dk
dk = [C1]
nguon = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nguon)
        If nguon(i, 2) = dk Then
            If Not .exists(nguon(i, 1)) Then
                .Add nguon(i, 1), ""
            End If
        End If
    Next
    For i = 1 To UBound(nguon)
        If Not .exists(nguon(i, 1)) Then
            k = k + 1
            .Add nguon(i, 1), ""
            kq(k, 1) = nguon(i, 1)
        End If
    Next
End With
[C2].Resize(k) = kq
End Sub

 

[chuot0106]

Thử code này coi sao

Sub ABC2()
Dim nguon(), kq(1 To 1000, 1 To 1), i, j, k, dk
dk = [C1]
nguon = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(nguon)
        If nguon(i, 2) = dk Then
            If Not .exists(nguon(i, 1)) Then
                .Add nguon(i, 1), ""
            End If
        End If
    Next
    For i = 1 To UBound(nguon)
        If Not .exists(nguon(i, 1)) Then
            k = k + 1
            .Add nguon(i, 1), ""
            kq(k, 1) = nguon(i, 1)
        End If
    Next
End With
[C2].Resize(k) = kq
End Sub

Quá ổn rồi anh ạ! Quá sợ với cái bài toán của thầy Siwtom!

 

[siwtom]

Ở phần trọng tâm thì tôi làm giống bạn Hau151978, chỉ khác về chi tiết. Tức như đã nói tôi cho Item = 0/1. Tôi dùng IF ... Else thay cho 2 IF. Và tôi tìm đúng, tức C1 thế nào thì tìm đúng, do vậy không dùng LIKE.

name = LCase([C1].Value)
...
Set dic = CreateObject("Scripting.Dictionary")
For k = 1 To UBound(Arr)
    If LCase(Arr(k, 2)) <> name Then
        If Not dic.exists(Arr(k, 1)) Then dic.Add Arr(k, 1), 0    ' <-- A
    Else
        dic.Item(Arr(k, 1)) = 1                ' <-- B
    End If
Next

Ngoài ra còn: xóa dữ liệu cũ, nếu cột A không có dữ liệu thì không làm gì cả. Nhưng những cái này không thuộc trọng tâm bài Toán, tôi chỉ ra bài về dic thôi.

Đã có lời giải nhưng không phải của bạn chuot0106, vậy thì những câu hỏi sau đây là dành cho bạn chuot0106. Yêu cầu người khác không trả lời, vì thực ra câu hỏi dễ, chỉ dành cho người đang "vọc" thôi.

1. Tại sao tôi không dùng ở A cấu trúc giống như ở B, tức

dic.Item(Arr(k, 1)) = 0

2. Tại sao tại A và B tôi không dùng cấu trúc
Tại A

If Not dic.exists(Arr(k, 1)) Then 
    dic.Item(Arr(k, 1)) = 0
else
    dic.Item(Arr(k, 1)) = 0
end if

Tại B

If Not dic.exists(Arr(k, 1)) Then 
    dic.Item(Arr(k, 1)) = 1
else
    dic.Item(Arr(k, 1)) = 1
end if

Dùng tại A như trên được không? Dùng tại B như trên được không? Nếu được/không được (cùng lắm thì chạy code là biết) thì giải thích tại sao được/không được.

 

[chuot0106]

Thực ra bạn chỉ bí về thuật toán còn các thuộc tính và phương thức của dic bạn nắm gọn trong lòng bàn tay rồi còn gì.
Chính vì thế tôi mới nhấn mạnh: thuật toán là cái khó và phải học mãi. Rèn luyện tư duy.

Có thể có nhiều hướng, tôi nghĩ đơn giản thế này. Ta duyệt cột A và cho vào dic những tên thành phố. Kết quả phải đạt được là: những tên trong dic mà C1 đã đến thì có Item = 1, những tên chưa đến thì có Item = 0. Sau khi duyệt hết cột A (có thể A, B đập vào mảng trước đó) thì đọc ra những Key mà có Item = 0. Thế thôi.
Tôi không chỉ rõ cách thêm Key vào dic như thế nào vì nếu chỉ ra thì xong bài toán rồi còn gì.

Thầy có thể cho em xin dòng code đọc ra những key có item =0 được không ạ!

 

[Hoàng Trọng Nghĩa]

Thầy có thể cho em xin dòng code đọc ra những key có item =0 được không ạ!

Thí nghiệm nhiều sẽ thấy thôi. Làm 1 vòng lặp cho tất cả các key, nếu key nào có item = 0 thì "hốt" key đó vào một mảng 1 chiều, khai báo mảng đó bằng ReDim Preserve để mảng đó giữ tất cả các key có điều kiện đó, chỉ vậy thôi.

 

[chuot0106]

Thí nghiệm nhiều sẽ thấy thôi. Làm 1 vòng lặp cho tất cả các key, nếu key nào có item = 0 thì "hốt" key đó vào một mảng 1 chiều, khai báo mảng đó bằng ReDim Preserve để mảng đó giữ tất cả các key có điều kiện đó, chỉ vậy thôi.

Do các công cụ của dic e chưa nắm hết nên học rất khó khăn. Cũng tại ít tài liệu nói về dic quá!