Học Dictionary qua các ví dụ đơn giản!

chuot0106 · 7/6/14

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!

AnhThu-1976 · 7/9/19

snow25 đã viết:
lr1 = .Range("I" & Rows.Count).End(xlUp).Row data = .Range("A3:E" & lr).Value
data = .Range("A3:E" & lr).Value

Cái trên hình như phải sửa là

Mã:

 lr1 = .Range("A" & Rows.Count).End(xlUp).Row
         data = .Range("A3:E" & lr1).Value

Phải không bạn!

dongducnhiem · 7/9/19

Tôi có lấy bài tập trên về làm và thử viết code
Sau khi viết và chạy code thì nó ra kết quả sai sai
Các bạn tìm chỗ sai giúp
Code như sau
Sub CDTK_()
Dim EndR1&, EndR2&, i&, s&, nR&
Dim sTK$
Dim Dic As Object
Dim ShName$
Dim Arr, ArrTK, ArrKQ

ShName = ActiveSheet.Name

Set Dic = CreateObject("scripting.dictionary")
With Sheets(ShName)
.Range("B3:C7").Clear
EndR1 = .Range("A" & Rows.Count).End(xlUp).Row
ArrTK = .Range("A3:C" & EndR1).Value
's = 0
For i = 1 To UBound(ArrTK)
sTK = ArrTK(i, 1)
s = s + 1
Dic.Add sTK, s
Next i
End With

With Sheets("BaiTap_2")
EndR2 = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A3:E" & EndR2).Value
End With
If Month(Arr(i, 1)) = 2 Then

' cong phat sinh no
sTK = Arr(i, 3)
nR = Dic.Item(sTK)
If nR Then
ArrTK(nR, 2) = ArrTK(nR, 2) + Arr(i, 5)
End If
'cong phat sinh co
sTK = Arr(i, 4)
nR = Dic.Item(sTK)
If nR Then
ArrTK(nR, 3) = ArrTK(nR, 3) + Arr(i, 5)
End If
End If
With Sheets(ShName)
Range("b3:c7") = ArrTK
End With
End Sub

batman1 · 7/9/19

dongducnhiem đã viết:
Tôi có lấy bài tập trên về làm và thử viết code
Sau khi viết và chạy code thì nó ra kết quả sai sai
Các bạn tìm chỗ sai giúp
Code như sau
Sub CDTK_()
Dim EndR1&, EndR2&, i&, s&, nR&
Dim sTK$
Dim Dic As Object
Dim ShName$
Dim Arr, ArrTK, ArrKQ

ShName = ActiveSheet.Name

Set Dic = CreateObject("scripting.dictionary")
With Sheets(ShName)
.Range("B3:C7").Clear
EndR1 = .Range("A" & Rows.Count).End(xlUp).Row
ArrTK = .Range("A3:C" & EndR1).Value
's = 0
For i = 1 To UBound(ArrTK)
sTK = ArrTK(i, 1)
s = s + 1
Dic.Add sTK, s
Next i
End With

With Sheets("BaiTap_2")
EndR2 = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A3:E" & EndR2).Value
End With
If Month(Arr(i, 1)) = 2 Then

' cong phat sinh no
sTK = Arr(i, 3)
nR = Dic.Item(sTK)
If nR Then
ArrTK(nR, 2) = ArrTK(nR, 2) + Arr(i, 5)
End If
'cong phat sinh co
sTK = Arr(i, 4)
nR = Dic.Item(sTK)
If nR Then
ArrTK(nR, 3) = ArrTK(nR, 3) + Arr(i, 5)
End If
End If
With Sheets(ShName)
Range("b3:c7") = ArrTK
End With
End Sub

Hãy cho code vào thẻ CODE.

Tôi không bàn về các việc khác. Chỉ bàn về cái bạn hỏi.

Nhìn lướt qua thì thế này:
1.

Mã:

If Month(Arr(i, 1)) = 2 Then
    ' cong phat sinh no
    sTK = Arr(i, 3)
    nR = Dic.Item(sTK)
    If nR Then
        ArrTK(nR, 2) = ArrTK(nR, 2) + Arr(i, 5)
    End If
    'cong phat sinh co
    sTK = Arr(i, 4)
    nR = Dic.Item(sTK)
    If nR Then
        ArrTK(nR, 3) = ArrTK(nR, 3) + Arr(i, 5)
    End If
End If

i trong code trên là gì, được tính thế nào?

Đoán mò, phải là

Mã:

For i = 1 To UBound(Arr)
    If Month(Arr(i, 1)) = 2 Then
        ' cong phat sinh no
        sTK = Arr(i, 3)
        nR = Dic.Item(sTK)
        If nR Then
            ArrTK(nR, 2) = ArrTK(nR, 2) + Arr(i, 5)
        End If
        'cong phat sinh co
        sTK = Arr(i, 4)
        nR = Dic.Item(sTK)
        If nR Then
            ArrTK(nR, 3) = ArrTK(nR, 3) + Arr(i, 5)
        End If
    End If
Next i

2. Thay

Mã:

With Sheets(ShName)
        Range("b3:c7") = ArrTK
End With

bằng

With Sheets(ShName)
.Range("A3:c7") = ArrTK
End With

Về dấu . thì không có cũng được vì trong trường hợp này code chạy cho activesheet. Nhưng nếu đã "chắc chắn" là vây thì With ... End With để mà làm gì? Nếu đã "chắc chắn" thì chỉ cần

Mã:

        Range("A3:c7") = ArrTK

Đã chơi With ... End With thì chơi tới cùng, trước sau như một - nhất quán. Tức thêm dấu chấm.

ArrTK lấy từ cột A (tới cột C) vậy thì khi đập lại vào sheet phải đập từ cột A.

VetMini · 7/9/19

batman1 đã viết:
... bằng Về dấu . thì không có cũng được vì trong trường hợp này code chạy cho activesheet. Nhưng nếu đã "chắc chắn" là vây thì With ... End With để mà làm gì? Nếu đã "chắc chắn" thì chỉ cần

Mã:

Range("A3:c7") = ArrTK

Đã chơi With ... End With thì chơi tới cùng, trước sau như một. Tức thêm dấu chấm. ...

Ở diễn đàn này chỉ có một sì tin viết code của một vài người đi đầu rồi những người sau cứ rập khuôn mà theo.
Khi sử dụng With, họ chỉ tiện dụng chứ không biết đến cái luật :
- With chỉ nên sử dụng cho các Objects không có mặc định bởi VBA. Bởi vì nếu lỡ gõ sót dấu chấm thì VBA sẽ tự động kéo Object mặc định vào, đưa đến kết quả sai
(khi đối tượng không có mặc định thì code sẽ dẫy nẫy lên, người code biết ngay là mình thiếu dấu chấm)

With Sheet không hẳn là không nên. Nhưng nếu không thể nắm vững các chỗ cần thêm chấm thì nên quên đi.

dongducnhiem · 7/9/19

Cảm ơn bạn nhiều nhiều

huuthang_bd · 7/9/19

Xài 1 lần mà cũng With thì máy móc quá rồi.

AnhThu-1976 · 9/9/19

snow25 đã viết:

Bạn thử nhé.

Mã:

Sub baitap2()
    Dim arr, i As Long, lr As Long, a As Long, data, dic As Object, dk As String, b As Long, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Baitap_2")
         lr = .Range("I" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         .Range("J3:K" & lr).ClearContents
         arr = .Range("I3:K" & lr).Value
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             dic.Item(dk) = i
         Next i
         lr1 = .Range("I" & Rows.Count).End(xlUp).Row
         data = .Range("A3:E" & lr1).Value
         For i = 1 To UBound(data)
             If Month(data(i, 1)) = 2 Then
                dk = data(i, 3)
                a = dic.Item(dk)
                If a Then
                   arr(a, 2) = arr(a, 2) + data(i, 5)
                End If
                dk = data(i, 4)
                a = dic.Item(dk)
                If a Then
                   arr(a, 3) = arr(a, 3) + data(i, 5)
                End If
             End If
        Next i
        .Range("I3:K" & lr).Value = arr
   End With
End Sub

Các anh chị cho em hỏi
Ở bài này, khi em dời đoạn code

Mã:

.Range("J3:K" & lr).ClearContents

Xuống và trước đoạn

Mã:

.Range("I3:K" & lr).Value = arr

Khi chạy code
1/ Chạy code lần đầu tiên và khi ở mảng kết quả xóa hết thì code chạy đúng
2/ Nếu tiếp tục cho code chạy lần thứ 2 thì ở phần kết quả sẽ cộng dồn lên
3/ Và nếu tiếp tục chạy code thì nó tiếp tục cộng dồn ....

Em thấy 1 số người viết code thì trước khi gán kết quả xuống sheet thì họ mới dùng lệnh ClearContents
Cho em hỏi: Không dùng lệnh ClearContents từ đầu, mà muốn dùng lệnh ClearContents sau, trước khi gán kết quả thì code cần phải làm sao
Nhờ các anh/chị viết và giải thích giùm, em cảm ơn!
"híc, tối ngày code mảng, dic thì có ngày chồng em nó phang cho em 1 mảng vào đầu hay quất dic chết"

snow25 · 9/9/19

AnhThu-1976 đã viết:
Các anh chị cho em hỏi
Ở bài này, khi em dời đoạn code

Mã:

.Range("J3:K" & lr).ClearContents

Xuống và trước đoạn

Mã:

.Range("I3:K" & lr).Value = arr

Khi chạy code
1/ Chạy code lần đầu tiên và khi ở mảng kết quả xóa hết thì code chạy đúng
2/ Nếu tiếp tục cho code chạy lần thứ 2 thì ở phần kết quả sẽ cộng dồn lên
3/ Và nếu tiếp tục chạy code thì nó tiếp tục cộng dồn ....

Em thấy 1 số người viết code thì trước khi gán kết quả xuống sheet thì họ mới dùng lệnh ClearContents
Cho em hỏi: Không dùng lệnh ClearContents từ đầu, mà muốn dùng lệnh ClearContents sau, trước khi gán kết quả thì code cần phải làm sao
Nhờ các anh/chị viết và giải thích giùm, em cảm ơn!
"híc, tối ngày code mảng, dic thì có ngày chồng em nó phang cho em 1 mảng vào đầu hay quất dic chết"

Thì đúng như bạn nói nếu không xóa đi thì nó cộng dồn lên.Vậy nên phải xóa trước khi cho nó vào mảng nhé.

AnhThu-1976 · 9/9/19

snow25 đã viết:
Thì đúng như bạn nói nếu không xóa đi thì nó cộng dồn lên.Vậy nên phải xóa trước khi cho nó vào mảng nhé.

Ở đây mình không nói code bạn sai
Mà chỉ nói khi cho lệnh ClearContents xuống dưới và code chạy nhiều lần thì code cho kết quả khác nhau(cộng dồn)
Ở file đính kèm của mình dưới đây dù cho lệnh ClearContents ở những vị trí khác nhau và code chạy nhiều lần thì code cho kết quả vẫn như nhau (đã cho lệnh ClearContents xuống dưới)(thậm chí bỏ hẳn đoạn ClearContents thì khi gán kết quả xuống thì mảng mới nó cũng tự xóa kết quả củ và gán kết quả mới vào)

Ý mình muốn tìm hiểu và nhờ các anh/chị phân tích và sửa lại code ở bài trên để nhấn code dù nhiều lần nhưng chạy đúng dù đặt lệnh ClearContents ở phía trên hay phía dưới
p/s: do mình đang học hỏi nên có nhiều thắc mắc, bản thân không tự giải được nên mới hỏi.Mong bạn thông cảm
Cảm ơn bạn và các anh/chị!

VetMini · 9/9/19

Các phần sau này là bà con hỏi về liên hệ giữa mảng trên sheet (range) và mảng trong VBA (mảng 2 chiều để đọc, xào nấu, và ghi dữ liệu mảng sheet). Đâu có phải là Đít đơn giản gì nữa.
Vấn đề hết là đơn giản rồi. Nên mở thớt khác hỏi cho rõ.

CHAOQUAY · 9/9/19

AnhThu-1976 đã viết:
Các anh chị cho em hỏi
Ở bài này, khi em dời đoạn code

Mã:

.Range("J3:K" & lr).ClearContents

Xuống và trước đoạn

Mã:

.Range("I3:K" & lr).Value = arr

Khi chạy code
1/ Chạy code lần đầu tiên và khi ở mảng kết quả xóa hết thì code chạy đúng
2/ Nếu tiếp tục cho code chạy lần thứ 2 thì ở phần kết quả sẽ cộng dồn lên
3/ Và nếu tiếp tục chạy code thì nó tiếp tục cộng dồn ....

Em thấy 1 số người viết code thì trước khi gán kết quả xuống sheet thì họ mới dùng lệnh ClearContents
Cho em hỏi: Không dùng lệnh ClearContents từ đầu, mà muốn dùng lệnh ClearContents sau, trước khi gán kết quả thì code cần phải làm sao
Nhờ các anh/chị viết và giải thích giùm, em cảm ơn!
"híc, tối ngày code mảng, dic thì có ngày chồng em nó phang cho em 1 mảng vào đầu hay quất dic chết"

Cộng dồn là tại dòng lệnh Arr=...
Bạn sửa bên trên

Mã:

Arr = .Range("I3:K" & lr).Value    '<-- Ket qua lan tinh 1 bi ghi vao Arr

thêm câu lệnh bên dưới rồi chạy thử 2 cách : xóa hoặc không sẽ thấy rõ

Mã:

Arr = .Range("I3:K" & lr).Value    '<-- Ket qua lan tinh 1 bi ghi vao Arr
Sheet4.Range("M3").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
Exit Sub

AnhThu-1976 · 9/9/19

VetMini đã viết:
Các phần sau này là bà con hỏi về liên hệ giữa mảng trên sheet (range) và mảng trong VBA (mảng 2 chiều để đọc, xào nấu, và ghi dữ liệu mảng sheet). Đâu có phải là Đít đơn giản gì nữa.
Vấn đề hết là đơn giản rồi. Nên mở thớt khác hỏi cho rõ.

Ở bài #127 em vẫn thấy Dic trong code mà, cụ thể
Set Dic = CreateObject("scripting.dictionary")
Thực tế vì em không biết code trên chỉ gọi là mảng hay Dic đơn thuần!
Vì em đang học hỏi nên nhiều thắc mắc, Vì bài tập và code ở chủ đề này nên tiện thể em hỏi để thuận tiện chứ không thì em đã mở chủ đề mới

AnhThu-1976 · 9/9/19

CHAOQUAY đã viết:
Cộng dồn là tại dòng lệnh Arr=...
Bạn sửa bên trên

Mã:

Arr = .Range("I3:K" & lr).Value '<-- Ket qua lan tinh 1 bi ghi vao Arr

thêm câu lệnh bên dưới rồi chạy thử 2 cách : xóa hoặc không sẽ thấy rõ

Mã:

Arr = .Range("I3:K" & lr).Value '<-- Ket qua lan tinh 1 bi ghi vao Arr Sheet4.Range("M3").Resize(UBound(Arr), UBound(Arr, 2)) = Arr Exit Sub

Nếu không đưa

Mã:

Arr = .Range("I3:K" & lr).Value    '<-- Ket qua lan tinh 1 bi ghi vao Arr

thì làm sao mà tính!

CHAOQUAY đã viết:
thêm câu lệnh bên dưới rồi chạy thử 2 cách : xóa hoặc không sẽ thấy rõ

Mã:

Arr = .Range("I3:K" & lr).Value '<-- Ket qua lan tinh 1 bi ghi vao Arr Sheet4.Range("M3").Resize(UBound(Arr), UBound(Arr, 2)) = Arr Exit Sub

Như vậy, khi gán xuống sheet thì tùy câu lệnh để nó gán đúng
Không biết ngoài câu lệnh trên để gán kết quả thì có thêm cách nào khác không?
Một lần nữa, cảm ơn bạn rất nhiều
Mình nghỉ, các code trên không những giúp cho mình mà còn giúp cho nhiều người khác(cho những người chập chững với code)

CHAOQUAY · 9/9/19

AnhThu-1976 đã viết:
Nếu không đưa

Mã:

Arr = .Range("I3:K" & lr).Value '<-- Ket qua lan tinh 1 bi ghi vao Arr

thì làm sao mà tính!

Như vậy, khi gán xuống sheet thì tùy câu lệnh để nó gán đúng
Không biết ngoài câu lệnh trên để gán kết quả thì có thêm cách nào khác không?
Một lần nữa, cảm ơn bạn rất nhiều
Mình nghỉ, các code trên không những giúp cho mình mà còn giúp cho nhiều người khác(cho những người chập chững với code)

Tất nhiên là vẫn gán Arr=... để tính toán. Hai câu lệnh bổ sung để bạn có thể nắm rõ hơn vì sao bị cộng dồn.
- Nếu có xóa vùng I3:K... Bạn sẽ thấy mảng Arr hiển thị cột đầu tiên có mã số, các ô còn lại là rỗng, vì vậy các phép tính tiếp theo là giá trị 1 lần chạy code -> kết quả đúng
- Nếu không xóa, ngoài cột đầu tiên, một vài ô của mảng Arr sẽ có giá trị khác rỗng & = kết quả của lần tính trước. Dẫn đến, các phép tính phía sau sẽ được cộng thêm giá trị cho trước này -> cái mà bạn gọi là cộng dồn

Tất cả phép tính phía sau lệnh gán mảng Arr đều đúng, lỗi xảy ra là do khi gán mảng, các ô tính toán có giá trị cho trước hay không.
Thêm 2 câu lệnh là muốn bạn nhìn thấy giá trị được cho trước của mảng arr khi gán là rỗng hay không vậy thôi

VetMini · 9/9/19

AnhThu-1976 đã viết:
Ở bài #127 em vẫn thấy Dic trong code mà, cụ thể
Set Dic = CreateObject("scripting.dictionary")
...

Xem cái chỗ dưới đây có liên quan gì đến sử dụng đít sần?

CHAOQUAY đã viết:
Tất nhiên là vẫn gán Arr=... để tính toán. Hai câu lệnh bổ sung để bạn có thể nắm rõ hơn vì sao bị cộng dồn.
- Nếu có xóa vùng I3:K... Bạn sẽ thấy mảng Arr hiển thị cột đầu tiên có mã số, các ô còn lại là rỗng, vì vậy các phép tính tiếp theo là giá trị 1 lần chạy code -> kết quả đúng
- Nếu không xóa, ngoài cột đầu tiên, một vài ô của mảng Arr sẽ có giá trị khác rỗng & = kết quả của lần tính trước. Dẫn đến, các phép tính phía sau sẽ được cộng thêm giá trị cho trước này -> cái mà bạn gọi là cộng dồn

Tất cả phép tính phía sau lệnh gán mảng Arr đều đúng, lỗi xảy ra là do khi gán mảng, các ô tính toán có giá trị cho trước hay không.
Thêm 2 câu lệnh là muốn bạn nhìn thấy giá trị được cho trước của mảng arr khi gán là rỗng hay không vậy thôi

AnhThu-1976 · 9/9/19

CHAOQUAY đã viết:
Tất nhiên là vẫn gán Arr=... để tính toán. Hai câu lệnh bổ sung để bạn có thể nắm rõ hơn vì sao bị cộng dồn.
- Nếu có xóa vùng I3:K... Bạn sẽ thấy mảng Arr hiển thị cột đầu tiên có mã số, các ô còn lại là rỗng, vì vậy các phép tính tiếp theo là giá trị 1 lần chạy code -> kết quả đúng
- Nếu không xóa, ngoài cột đầu tiên, một vài ô của mảng Arr sẽ có giá trị khác rỗng & = kết quả của lần tính trước. Dẫn đến, các phép tính phía sau sẽ được cộng thêm giá trị cho trước này -> cái mà bạn gọi là cộng dồn

Tất cả phép tính phía sau lệnh gán mảng Arr đều đúng, lỗi xảy ra là do khi gán mảng, các ô tính toán có giá trị cho trước hay không.
Thêm 2 câu lệnh là muốn bạn nhìn thấy giá trị được cho trước của mảng arr khi gán là rỗng hay không vậy thôi

Bạn bật mí thêm 1 tý được (cụ thể thêm code ở đoạn nào) không ạ!

HeSanbi · 9/9/19

AnhThu-1976 đã viết:
Ở bài #127 em vẫn thấy Dic trong code mà, cụ thể
Set Dic = CreateObject("scripting.dictionary")
Thực tế vì em không biết code trên chỉ gọi là mảng hay Dic đơn thuần!
Vì em đang học hỏi nên nhiều thắc mắc, Vì bài tập và code ở chủ đề này nên tiện thể em hỏi để thuận tiện chứ không thì em đã mở chủ đề mới

Tôi sẽ mô tả giúp bạn Dictionary cụ thể để dễ hiểu

Nếu bạn biết Json thì rất dễ hiểu về Dictionary
Trong một tập tin JSON bao gồm cả Dictionary và Collection

Một Dictionary không bao giờ chứa hơn 1 key giống nhau, mỗi Key đại diện là một Value / Dict khác hoặc một Collection

Diễn tả:
Dictionary = { "Key1" : "Value" , "Key2" : "Value" }

Những phương thức để Thêm, xóa, đếm, ...
+ Xác định phương thức tìm kiếm dạng Text hoặc Database hoặc Binary:
Dict.CompareMode = TextCompare '/DatabaseCompare '/BinaryCompare
+ Thêm:
Dict.Add "Key1", "Value"
+ Đếm xem có bao nhiêu Key
I = Dict.Count
+ Kiểm tra Key đã tồn tại hay chưa
Debug.Print Dict.Exists ("Key1")
+ Thay đổi tên của Key thành một tên khác
Dict.Key("Key1") = "Key5"
+ Trả lại mảng chỉ bao gồm các Key
Arr = Dict.Keys
+ Trả lại một Value của Key
Debug.Print Dict.Item ("Key1")
+ Trả lại mảng chỉ bao gồm các Value
Arr = Dict.Items
+ Xóa một Key và Value khỏi Dict
Dict.Remove "Key1"
+ Làm rỗng toàn bộ Dict
Dic.RemoveAll

Một Collection: Có thể là một Collection đơn thuần hoặc chứa cả Dictionary

Diễn tả:
Collection = [ 1, "A", 3, 4 ]
Collection = [ { "Key1" : "Value" , "Key2" : "Value" } , { "Key1" : "Value" , "Key2" : "Value" } ]

Đã học Dictionary thì nên đi kèm Json, bạn tải Module JsonConverter về để học:
https://github.com/VBA-tools/VBA-JSON

batman1 · 9/9/19

AnhThu-1976 đã viết:
Bạn bật mí thêm 1 tý được (cụ thể thêm code ở đoạn nào) không ạ!

Giải thích như thế mà bạn không hiểu?

Thì lấy vd. sẽ nhìn thấy ngay mà.

Mã:

For i = 1 To UBound(Arr)    ' xeět týĚ doĚng 1 đęěn doĚng cuôěi cuŇa arr
    dk = Arr(i, 1)    ' (C) dăňt dk laŇ côňt I coě săŢn
    Dic.Item(dk) = i    ' (D) đýa Item noě vaĚo
Next i
...
Arr = .Range("I3:K" & lr).Value     ' (A)
...
For i = 1 To UBound(data)
...
    dk = data(i, 4)    'xeět côňt D
    a = Dic.Item(dk)
    If a Then
        Arr(a, 3) = Arr(a, 3) + data(i, 5)    '  (B) côňng dôĚn côňt E theo côňt TK coě
    End If
...
Next i

Ta chỉ xét Arr(1, 3), các Arr(...) khác tương tự.

A. Lần chạy đầu
0. Xét vòng lặp For i = 1 To UBound(Arr).
Với i = 1 có dk = Arr(i, 1) = Arr(1, 1) = I3 = 131 do (C). Code thêm vào đít sần Mã 131 với tư cách là KEY và 1 (i = 1) với tư cách là ITEM - dòng (D).

1. Arr(a, 3) khi đập xuống sheet chính là Có, tức vào cột K.

2. sau dòng (A) ta có Arr(1, 3) rỗng do vùng J3:K8 chưa có gì.
Trong dữ liệu nguồn data thì Mã 131 xuất hiện 2 lần tại data(4, 4) - D6 và data(6, 4) - D8 nên trong vòng lặp For sé có 2 chỗ gặp Mã 131
a.Với i = 4 có:
dk = data(i, 4) = data(4, 4) = 131
a = Dic.Item(dk) = Dic.Item(131) = 1 (điểm 0 ở trên)
Do a = 1 > 0 nên tại (B) có:
Arr(1, 3) = Arr(a, 3) = Arr(a, 3) + data(i, 5) = A(1, 3) + data(4, 5) = 0 + 500 000 = 500 000 ' do Arr(1, 3) rỗng
b. Với i = 6 có:
dk = data(i, 4) = data(6, 4) = 131
a = Dic.Item(dk) = Dic.Item(131) = 1 (điểm 0 ở trên)
Do a = 1 > 0 nên tại (B) có:
Arr(1, 3) = Arr(a, 3) = Arr(a, 3) + data(i, 5) = A(1, 3) + data(6, 5) = 500 000 + 500 000 = 1 000 000 ' do Arr(1, 3) = 500 000 sau khi thực hiện điểm a.

B. Lần chạy code thứ 2.
0. Xét vòng lặp For i = 1 To UBound(Arr).
Với i = 1 có dk = Arr(i, 1) = Arr(1, 1) = I3 = 131 do (C). Code thêm vào đít sần Mã 131 với tư cách là KEY và 1 (i = 1) với tư cách là ITEM - dòng (D).

1. Arr(a, 3) khi đập xuống sheet chính là Có, tức vào cột K.

2. sau dòng (A) ta có Arr(1, 3) = 1 000 000 - không rỗng do vùng J3:K8 đã có kết quả sau lần chạy 1 mà ta lại không xóa kết quả đó. Code đã nhập vùng có dữ liệu J3:K8 vào mảng Arr.

Trong dữ liệu nguồn data thì Mã 131 xuất hiện 2 lần tại data(4, 4) - D6 và data(6, 4) - D8 nên trong vòng lặp For sẽ có 2 chỗ gặp Mã 131
a.Với i = 4 có:
dk = data(i, 4) = data(4, 4) = 131
a = Dic.Item(dk) = Dic.Item(131) = 1 (điểm 0 ở trên)
Do a = 1 > 0 nên tại (B) có:
Arr(1, 3) = Arr(a, 3) = Arr(a, 3) + data(i, 5) = A(1, 3) + data(4, 5) = 1 000 000 + 500 000 = 1 500 000 ' do Arr(1, 3) = 1 000 000 từ kết quả chạy lần 1.
b. Với i = 6 có:
dk = data(i, 4) = data(6, 4) = 131
a = Dic.Item(dk) = Dic.Item(131) = 1 (điểm 0 ở trên)
Do a = 1 > 0 nên tại (B) có:
Arr(1, 3) = Arr(a, 3) = Arr(a, 3) + data(i, 5) = A(1, 3) + data(6, 5) = 1 500 000 + 500 000 = 2 000 000 ' do Arr(1, 3) = 1 500 000 sau khi thực hiện điểm a.

Tóm lại sau khi chạy lần 2 thì Arr(1, 3) = 2 000 000. Khi đập xuống sheet thì K3 = 2 000 000

Với code của snow thì sau dòng (A) mảng Arr luôn có cột 2 và 3 rỗng do trước đó đã xóa dữ liệu trên sheet. Tức không bao giờ có đỏ đỏ.

AnhThu-1976 · 9/9/19

Từ chiều đến giờ đọc hiểu thêm 1 tý
Nhưng em thấy vẫn lạ như ở bài 129 thì code không cộng dồn khi bấm code từ 2 lần trở lên
Hay do khi gán xuống sheet thì tùy câu lệnh để nó gán đúng như bài 131

CHAOQUAY · 9/9/19

AnhThu-1976 đã viết:
Từ chiều đến giờ đọc hiểu thêm 1 tý
Nhưng em thấy vẫn lạ như ở bài 129 thì code không cộng dồn khi bấm code từ 2 lần trở lên
Hay do khi gán xuống sheet thì tùy câu lệnh để nó gán đúng như bài 131

2 code khác nhau ở chỗ 1 cái khai báo Arr rỗng & một cái gán từ sheet vào arr nên khác rỗng.
Cái nào rỗng thì chạy n lần không sai, khác rỗng chạy >1 lần thì sai nếu không xóa trước.
Không phải sai do .range().clear... tại đầu hay là cuối

Mã:

Sub Cau_2_MangArr_KhaiBaoRong()
    Dim Dic1 As Object, iRow As Long, i As Long
    Dim Arr() As Variant, TmpArr As Variant
    With Sheets("Cau1")
        '.Range("E40:H100").ClearContents
        Set Dic1 = CreateObject("Scripting.Dictionary")

        TmpArr = Sheets("Cau1").Range("B2:G21").Value
        ReDim Arr(1 To UBound(TmpArr, 1), 1 To 6)'<<--Khai bao rong, khong co gi

        For iRow = 1 To UBound(TmpArr, 1)
            If Not IsEmpty(TmpArr(iRow, 2)) And Not Dic1.exists(TmpArr(iRow, 2)) Then
                i = i + 1
                Dic1.Add TmpArr(iRow, 2), i
                Arr(i, 1) = TmpArr(iRow, 1)
                Arr(i, 2) = TmpArr(iRow, 2)
                If TmpArr(iRow, 3) <> "" Then
                    Arr(i, 3) = TmpArr(iRow, 6)

                Else
                    Arr(i, 4) = TmpArr(iRow, 6)
                End If
            Else
                If TmpArr(iRow, 3) <> "" Then
                    Arr(Dic1.Item(TmpArr(iRow, 2)), 3) = Arr(Dic1.Item(TmpArr(iRow, 2)), 3) + TmpArr(iRow, 6)
                Else
                    Arr(Dic1.Item(TmpArr(iRow, 2)), 4) = Arr(Dic1.Item(TmpArr(iRow, 2)), 4) + TmpArr(iRow, 6)

                End If
            End If
        Next iRow
        .Range("E40:H100").ClearContents
        .Range("E40").Resize(i, 4).Value = Arr
    End With
End Sub

Mã:

Sub baitap2_MangArr_GanTuSheetVaoArr_KhaiBaoKhacRong()
    Dim Arr, i As Long, lr As Long, a As Long, data, Dic As Object, dk As String, b As Long, lr1 As Long
    Set Dic = CreateObject("scripting.dictionary")


    With Sheets("Baitap_2")
        lr = .Range("I" & Rows.Count).End(xlUp).Row    ' taòo doÌng cuôìi côòt I
        If lr < 3 Then Exit Sub
        '.Range("J3:K" & lr).ClearContents    ' xoìa vuÌng dýÞ liêòu kêìt quaÒ

        Arr = .Range("I3:K" & lr).Value    ' ðýa vuÌng dýÞ liêòu coì sãÞn vaÌ vuÌng KQ<<<<<=====Gan tu sheet vao mang. Arr khac rong
        For i = 1 To UBound(Arr)    ' xeìt týÌ doÌng 1 ðêìn doÌng cuôìi cuÒa arr
            dk = Arr(i, 1)    ' dãòt dk laÒ côòt I coì sãÞn
            Dic.Item(dk) = i    ' ðýa Item noì vaÌo
        Next i

        lr1 = .Range("A" & Rows.Count).End(xlUp).Row    'taòo doÌng cuôìi côòt A
        data = .Range("A3:E" & lr1).Value    ' ðýa vuÌng dýÞ liêòu nguôÌn
        For i = 1 To UBound(data)    ' xeìt týÌ doÌng 1 ðêìn doÌng cuôìi cuÒa nguôÌn


            If Month(data(i, 1)) = 2 Then    ' nêìu côòt A laÌ thaìng 2

                dk = data(i, 3)    ' xeìt côòt C
                a = Dic.Item(dk)
                If a Then
                    Arr(a, 2) = Arr(a, 2) + data(i, 5)    ' côòng dôÌn côòt E theo côòt TK nõò

                End If

                dk = data(i, 4)    'xeìt côòt D
                a = Dic.Item(dk)
                If a Then
                    Arr(a, 3) = Arr(a, 3) + data(i, 5)    ' côòng dôÌn côòt E theo côòt TK coì
                End If
            End If
        Next i
        .Range("J3:K" & lr).ClearContents    ' xoìa vuÌng dýÞ liêòu kêìt quaÒ
        .Range("I3:K" & lr).Value = Arr
    End With
End Sub

---
Có lẽ lạc đề hơi xa. Đề tài về dic mà lại nói về gán dữ liệu.
Xin dừng tại đây.
Thân chào!

Học Dictionary qua các ví dụ đơn giản!

Thành viên gắn bó

Thành viên tích cực

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

File đính kèm

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

Ăn cùng góc phố

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

Chuyên gia GPE

Thành viên tích cực

File đính kèm

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

Thành viên tích cực

File đính kèm

Ăn cùng góc phố

Thành viên gắn bó

Thành viên tích cực

Thành viên tích cực

Thành viên gắn bó

Ăn cùng góc phố

Thành viên tích cực

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

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

Thành viên tích cực

Thành viên gắn bó

Facebook

Group