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

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!

siwtom · 11/6/14

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

Thế bạn đọc, phân tích từng dòng code của bạn Hau151978 mà bạn không hiểu à?

Mã:

For Each j In dic
    If Not (dic.Item(j)) Then
        Cells(i, 3) = j
        i = i + 1
    End If
Next

Bạn thử giải nghĩa cho tôi code trên làm gì.
Bạn cứ đi từng dòng một và tìm hiểu câu lệnh. Nếu bạn đọc code mà không hiểu được gì thì cũng có nghĩa bạn không học được gì. Cho dù bạn có học thuộc lòng code thì chỉ cần thay đổi bài toán chút ít thì bạn sẽ bó tay.

Chuyện đập xuống sheet trong mỗi vòng lặp hay đập vào mảng rồi sau vòng lặp mới đập xuống sheet chỉ là chuyện phụ. Code định làm cái gì? Lấy cái gì, từ đâu?. Nhìn thấy IF thì chắc bạn biết là việc "lấy" kia là có điều kiện, không phải lấy bừa, lấy tất tần tật.

Lập trình cũng như Toán. Phải hiểu bằng được.

Hau151978 · 11/6/14

siwtom đã viết:
tôi tìm đúng, tức C1 thế nào thì tìm đúng, do vậy không dùng LIKE.

Do trong đề bài có ghi "Hãy liệt kê (từ C2) những thành phố chưa từng đến bởi các vị ( không phân biệt Nam béo hay Nam lác. Cứ Nam là coi là 1) có tên nhập vào C1", em hiểu là nếu dữ liệu có 2 người tên bắt đầu là Nam (ví dụ Nam Anh và Nam Em) thì đều coi là 1 nên em dùng LIKE. Code của em vẫn còn lỗi nếu dữ liệu có Nam và Namm đều coi là Nam. Để sửa lại chắc phải thay so sánh B2 với C1 B2 like (C1 & "*") ở code trên bằng B2=C1 or (B2 like (C1 & " *")). (Trước dấu * có dấu cách)

chuot0106 · 11/6/14

Hau151978 đã viết:
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

Nhờ sự chỉ bảo, gợi ý của bạn Hau151978, thầy Siwtom, cùng anh HoangTrongNghia(đặc biệt là bạn Hau151978 đã rất nhiệt tình giải thích cặn kẽ) em đã hiểu được rất nhiều điều và em cũng đã hiểu được code của bạn Hau151978 và từ đó vận dụng em thử viết code nhưng dùng mảng mong các anh chị và các bạn nhận xét, góp ý!

Mã:

Public Sub cau5()
Dim arr(), kq(), i As Long, j As Variant, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("A2:B8")
ReDim kq(1 To UBound(arr, 1), 1 To 1)


    For i = 1 To UBound(arr, 1)
        If Not dic.Exists(arr(i, 1)) Then dic.Add arr(i, 1), 1
            If arr(i, 2) = [C1] Then dic.Item(arr(i, 1)) = 0
    Next
       i = 1
            Range("C2:C100").ClearContents
        For Each j In dic
            If dic.Item(j) Then
                kq(i, 1) = j
                i = i + 1
            End If
        Next
        [C2].Resize(i, 1) = kq
End Sub

VetMini · 11/6/14

"For Each j In dic" :

Theo lệ thuờng (lệ chứ không phải là luật, không bắt buộc) người ta chỉ dùng các tên i, j, k, ... cho số nguyên
Nếu bạn duyệt dict thì dùng biến tên khoa hay tenNguoi, tenTinh gì đó cho dễ đọc code.

Hau151978 · 12/6/14

Về mặt thuật toán trong bài này, mình thấy khó nhất khi duyệt bảng để lấy dữ liệu vào dic. Khi duyệt đến một hàng, ví dụ A3:B3, có các trường hợp xảy ra:
- Đã có key = A3 và B3=C1 ----> gán item =1
- Đã có key = A3 và B3<>C1 -----> không làm gì.
- Chưa có key = A3 và B3=C1 ------>tạo key A3, item=1
- Chưa có key =A3 và B3<>C1----->tạo key A3, item=0
Lợi dụng chức năng của dic là nếu truy xuất 1 key không tồn tại thì dic sẽ add key với item rỗng. Vậy có thể rút gọn 2 lệnh: if not(dic.exists(k))... và If B3=C2 ở bài của mình và lệnh if lồng của bác Siwtom thành 1 lệnh:
If (dic.item(k)<>1) and (r.Cells(i, 2).Text = s) then dic.item(k)=1
Mình không dùng dic.item(k)=0 vì có khả năng dic.item(k)="". Như vậy câu lệnh sẽ ngắn gọn hơn mặc dù khó hiểu hơn. Câu lệnh kiểm tra ở vòng lặp For each sửa thành if dic.item(j)<>1 then...

VetMini · 12/6/14

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

chuot0106 · 12/6/14

siwtom đã viết:
Ở phần trọng tâm thì tôi làm giống bạn Hau151978, chỉ khác về chi tiết. Tức như đã nói tôi cho Item = 0/1. Tôi dùng IF ... Else thay cho 2 IF. Và tôi tìm đúng, tức C1 thế nào thì tìm đúng, do vậy không dùng LIKE.

Mã:

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

Ngoài ra còn: xóa dữ liệu cũ, nếu cột A không có dữ liệu thì không làm gì cả. Nhưng những cái này không thuộc trọng tâm bài Toán, tôi chỉ ra bài về dic thôi.

Đã có lời giải nhưng không phải của bạn chuot0106, vậy thì những câu hỏi sau đây là dành cho bạn chuot0106. Yêu cầu người khác không trả lời, vì thực ra câu hỏi dễ, chỉ dành cho người đang "vọc" thôi.

1. Tại sao tôi không dùng ở A cấu trúc giống như ở B, tức

Mã:

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

2. Tại sao tại A và B tôi không dùng cấu trúc
Tại A

Mã:

If Not dic.exists(Arr(k, 1)) Then dic.Item(Arr(k, 1)) =[B] [COLOR=#ff0000]0[/COLOR][/B] else dic.Item(Arr(k, 1)) =[B] [COLOR=#ff0000]0[/COLOR][/B] end if

Tại B

Mã:

If Not dic.exists(Arr(k, 1)) Then dic.Item(Arr(k, 1)) = [COLOR=#ff0000][B]1[/B][/COLOR] else dic.Item(Arr(k, 1)) = [COLOR=#ff0000][B]1[/B][/COLOR] end if

Dùng tại A như trên được không? Dùng tại B như trên được không? Nếu được/không được (cùng lắm thì chạy code là biết) thì giải thích tại sao được/không được.

Em xin trả lời câu hỏi của thầy theo ý hiểu của em:
(1) Không thể dùng cấu trúc ở A giống ở B, vì ở A là gán item bằng 0 cho các key, còn cấu trúc ở B là em nghĩ là để thay đổi item (=1) cho các key thỏa điều kiện nào đó.
(2) thì không biết thầy có gõ nhầm không ạ? Em thấy trước và sau ELSE em thấy đều cùng là 1 số (0,1).

Hau151978 · 12/6/14

chuot0106 đã viết:
Em xin trả lời câu hỏi của thầy theo ý hiểu của em:
(1) Không thể dùng cấu trúc ở A giống ở B, vì ở A là gán item bằng 0 cho các key, còn cấu trúc ở B là em nghĩ là để thay đổi item (=1) cho các key thỏa điều kiện nào đó.
(2) thì không biết thầy có gõ nhầm không ạ? Em thấy trước và sau ELSE em thấy đều cùng là 1 số (0,1).

(1) không được vì nếu key đã có, item bằng 1 từ trước thì lệnh gán item=0 sẽ sai.
(2) tại A nếu thay đoạn mã như vậy thì như tình huống ở (1) lệnh gán item=0 ở Else sẽ sai; nếu sửa thành item=1 vẫn sai trong trường hợp key đã có từ trước và item cũ =0
tại B viết như vậy cũng được nhưng thừa vì cả 2 lệnh ở If và Else giống nhau nên có thể bỏ If.
Đoạn

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

có thể sửa thành if (dic.item(arr(k,1)) <>1) and (Lcase(arr(k,2))=name) then dic.item(arr(k,1))=1

siwtom · 12/6/14

Hau151978 đã viết:
(1) không được vì nếu key đã có, item bằng 1 từ trước thì lệnh gán item=0 sẽ sai.
(2) tại A nếu thay đoạn mã như vậy thì như tình huống ở (1) lệnh gán item=0 ở Else sẽ sai; nếu sửa thành item=1 vẫn sai trong trường hợp key đã có từ trước và item cũ =0
tại B viết như vậy cũng được nhưng thừa vì cả 2 lệnh ở If và Else giống nhau nên có thể bỏ If.

1. Đúng. Phần else sẽ làm sai kết quả
2. Chết thật, he he. Tôi viết nhầm (cứ kiểu copy/paste nên nhầm)

Phải là.
Tại A

Mã:

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

Tại B

Mã:

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

Tôi biết là câu hỏi dễ nên chỉ hỏi bạn chuot0106 thôi mà. Nhưng bạn đã trả lời thì làm nốt cho bạn chuot0106 học tập.

Đoạn

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

có thể sửa thành if (dic.item(arr(k,1)) <>1) and (Lcase(arr(k,2))=name) then dic.item(arr(k,1))=1

Nhiều khi biết là gộp được nhưng không gộp vì có thể nhìn code tối hơn, phải chú ý cẩn thận vì dễ sai hơn. Nhưng đây là tùy mỗi người. Thói quen thôi.

Ngoài ra Excel tính biểu thức lôgíc theo kiểu tính tất cả các biểu thức thành phần.

Mã:

IF a then
    if b then
        if c then
             bla
        end if
    end if
End if

và

Mã:

If a and b and c then
    ' bla
end If

bla ở trên chỉ chạy khi a, b, c đều trả về TRUE. Nhưng nếu a = FALSE thì code sẽ không làm gì, bất luận b, c thế nào. Ở code1 thì chỉ đk a được tính (khi a = FALSE). Ở code2 thì khi tính xong biết a = FALSE nhưng Excel vẫn tính tiếp biểu thức lôgíc b và c.

Bạn có thể mục sở thị. Hãy chạy 2 code

Mã:

Sub he1()
Dim dic As Object
    If Not dic Is Nothing Then
        If dic.exists("he he") Then
            dic.Item("he he") = "bla"
        End If
    End If
End Sub

Sub he2()
Dim dic As Object
    If Not dic Is Nothing And dic.exists("he he") Then
        dic.Item("he he") = "bla"
    End If
End Sub

code he1 chạy không lỗi vì sau khi kiểm tra đk 1 thì code không làm gì cả. code he2 chạy có lỗi vì VBA tính tất cả 2 đk. Vậy khi dic = Nothing thì trong quá trình kiểm tra đk 2 sẽ có lỗi.
--------------
Delphi chẳng hạn chỉ tính đk tới khi đã biết kết quả của biểu thức lôgíc.
vd. A = a and b and c and d and e
Khi Delphi tính và thấy a = FALSE thì cũng biết là A = FALSE vậy b, c, d không được tính nữa.

vd. A = a or b or c or d
Nếu a = FALSE, b = FALSE, c = TRUE thì Delphi không tính d mà trả về luôn A = TRUE.

Cách tính của VBA như thế là không tối ưu. Và với cách tính đó bạn không viết gọn được như ở he2

siwtom · 12/6/14

chuot0106 đã viết:
Em xin trả lời câu hỏi của thầy theo ý hiểu của em:
(1) Không thể dùng cấu trúc ở A giống ở B, vì ở A là gán item bằng 0 cho các key, còn cấu trúc ở B là em nghĩ là để thay đổi item (=1) cho các key thỏa điều kiện nào đó.

Ý là nếu bạn cố tình viết như thế thì có được không. Nếu được/không được thì tại sao. Phải trả lời như bạn Hau151978

(2) thì không biết thầy có gõ nhầm không ạ? Em thấy trước và sau ELSE em thấy đều cùng là 1 số (0,1).

Đúng là nhầm. Đọc bài #109 nhé

AnhThu-1976 · 6/9/19

Đọc qua các bài trên em chỉ hiểu sơ lược
Để em có thể áp dụng vào kế toán thì em nhờ các anh chị viết code về Dic để em học hỏi thêm
Trong file của em có 2 bài tập
Dựa vào sổ Nhật ký để tổng hợp ra bảng cân đối
Nếu được thì có thể giải thích sơ lược cho em các code mà anh /chị đã viết
BaiTap_1: Tổng hợp không cần ngày tháng
BaiTap_2: Tổng hợp Theo tháng
Em cảm ơn

tam888 · 6/9/19

Muốn học thì nên tự làm đi, mắc ở đâu đưa lên. Còn đưa file xlsx nghĩa là nhờ mọi người làm tất?

snow25 · 6/9/19

AnhThu-1976 đã viết:
Đọc qua các bài trên em chỉ hiểu sơ lược
Để em có thể áp dụng vào kế toán thì em nhờ các anh chị viết code về Dic để em học hỏi thêm
Trong file của em có 2 bài tập
Dựa vào sổ Nhật ký để tổng hợp ra bảng cân đối
Nếu được thì có thể giải thích sơ lược cho em các code mà anh /chị đã viết
BaiTap_1: Tổng hợp không cần ngày tháng
BaiTap_2: Tổng hợp Theo tháng
Em cảm ơn

Thử Bài tập 2.

Mã:

Sub baitap2()
    Dim arr, i As Long, lr As Long, a As Long, kq, dic As Object, dk As String, b As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Baitap_2")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A3:E" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 3)
         For i = 1 To UBound(arr)
           If Month(arr(i, 1)) = 2 Then
              dk = arr(i, 3)
              If Not dic.exists(dk) Then
                 a = a + 1
                 dic.Add dk, a
                 kq(a, 1) = dk
              End If
              b = dic.Item(dk)
              kq(b, 2) = kq(b, 2) + arr(i, 5)
              dk = arr(i, 4)
              If Not dic.exists(dk) Then
                 a = a + 1
                 dic.Add dk, a
                 kq(a, 1) = dk
              End If
              b = dic.Item(dk)
              kq(b, 3) = kq(b, 3) + arr(i, 5)
           End If
         Next i
         .Range("m3:O1000").ClearContents
        If a Then .Range("m3:o3").Resize(a).Value = kq
   End With
End Sub

AnhThu-1976 · 6/9/19

snow25 đã viết:
Thử Bài tập 2.

Cảm ơn bạn
Code của bạn tạo tất cả từ số Tài khoản đến số tiền
Ở đây bảng cân đối là "cố định" và có sẵn cột từ I3 đến I6
Nếu tài khoản nào không phát sinh số tiền thì để trống
Mình cũng không biết phải tạo Dic như thế nào và gián kết quả vào J3:K6

snow25 · 6/9/19

AnhThu-1976 đã viết:
Cảm ơn bạn
Code của bạn tạo tất cả từ số Tài khoản đến số tiền
Ở đây bảng cân đối là "cố định" và có sẵn cột từ I3 đến I6
Nếu tài khoản nào không phát sinh số tiền thì để trống
Mình cũng không biết phải tạo Dic như thế nào và gián kết quả vào J3:K6

Bạn muốn học về dic hay là muốn lấy kết quả như vậy.

AnhThu-1976 · 6/9/19

snow25 đã viết:
Bạn muốn học về dic hay là muốn lấy kết quả như vậy.

Vừa muốn vọc mà cũng muốn kế quả như vậy
Vì thực tế là 1 sẵn, họ yêu cầu mình điền vào

snow25 · 6/9/19

AnhThu-1976 đã viết:
Vừa muốn vọc mà cũng muốn kế quả như vậy
Vì thực tế là 1 sẵn, họ yêu cầu mình điền vào

Vậy mình nói ý tưởng bạn thực hiện nhé.
Đầu tiên là duyệt qua các phần tử của mảng kết quả có sẵn lấy vị trí của nó trong mảng đó bằng dictionary.Xong tiếp đến ta duyệt các phần tử ở data đã cho.Xem cái nào có ở bên vị trí mảng kết quả bằng cách kiểm tra dic.Rồi công các vị trí đó lại với nhau là xong.Bạn làm thử nếu trong ngày mai chưa xong mình viết code nhé.

nvh611 · 6/9/19

siwtom đã viết:
Thế bạn đọc, phân tích từng dòng code của bạn Hau151978 mà bạn không hiểu à?

Mã:

For Each j In dic If Not (dic.Item(j)) Then Cells(i, 3) = j i = i + 1 End If Next

Bạn thử giải nghĩa cho tôi code trên làm gì.
Bạn cứ đi từng dòng một và tìm hiểu câu lệnh. Nếu bạn đọc code mà không hiểu được gì thì cũng có nghĩa bạn không học được gì. Cho dù bạn có học thuộc lòng code thì chỉ cần thay đổi bài toán chút ít thì bạn sẽ bó tay.

Chuyện đập xuống sheet trong mỗi vòng lặp hay đập vào mảng rồi sau vòng lặp mới đập xuống sheet chỉ là chuyện phụ. Code định làm cái gì? Lấy cái gì, từ đâu?. Nhìn thấy IF thì chắc bạn biết là việc "lấy" kia là có điều kiện, không phải lấy bừa, lấy tất tần tật.

Lập trình cũng như Toán. Phải hiểu bằng được.

Một ông chuyên về lập trình, 1 ông chuyên về cái khác, e rằng sẽ rất khó, nó sẽ chỉ là học lỏm thôi

snow25 · 7/9/19

AnhThu-1976 đã viết:
Cảm ơn bạn
Code của bạn tạo tất cả từ số Tài khoản đến số tiền
Ở đây bảng cân đối là "cố định" và có sẵn cột từ I3 đến I6
Nếu tài khoản nào không phát sinh số tiền thì để trống
Mình cũng không biết phải tạo Dic như thế nào và gián kết quả vào J3:K6

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

AnhThu-1976 · 7/9/19

Cảm ơn bạn rất nhiều, để mình nghiên cứu cái gì chưa hiểu thì sẽ hỏi

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!

AnhThu-1976 · 9/9/19

Cảm ơn bạn mình đã hình dung ra rồi
Một lần nữa cảm ơn các anh, chúc các anh nhiều sức khỏe và thành đạt trong cuộc sống

Hoàng Nhật Phương · 5/4/20

chuot0106 đã viết:

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 ý!

Mã:

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

Xin chào các bạn,
Tôi tải tâp tin và code tại bài này về và thử làm một code sau để học Dictionary... và kết quả không giống như kết quả mẫu.
Tôi gửi code, nhờ các bạn xem và giúp tôi với ạ.

Mã:

Option Explicit

Function LastRowInOneColumn(Sheet As Worksheet, Ten_Cot As String) As Long
    LastRowInOneColumn = Sheet.Cells(Sheet.Rows.Count, Ten_Cot).End(xlUp).Row
End Function

Sub HocDic_1()

    Dim MyDic As Scripting.Dictionary
    Set MyDic = New Scripting.Dictionary
    
    Dim Sh As Worksheet, Key As String
    Dim i As Long, j As Long, k As Long, dongcuoi As Long
    Dim dauvao As Variant, daura As Variant
    
    Set Sh = ThisWorkbook.Worksheets("Sheet1")
    
    dongcuoi = LastRowInOneColumn(Sh, "B")
    If dongcuoi < 2 Then Exit Sub
    
    dauvao = Sh.Range("A2:B" & dongcuoi).Value
    
    ReDim daura(UBound(dauvao, 1), UBound(dauvao, 2))
    
    For i = 1 To UBound(dauvao, 1)
        Key = dauvao(i, 1)
        If MyDic.Exists(Key) = False Then
            k = k + 1
            MyDic.Add Key, k
            For j = 1 To UBound(dauvao, 2)
                daura(k, j) = dauvao(i, j)
            Next j
            Debug.Print daura(k, 1) & "-" & daura(k, 2)
        End If
    Next i
    
    Sh.Range("F2").Resize(100, 2).ClearContents
    Debug.Print "Row:" & k & "-" & "Col:" & UBound(daura, 2)
    
    If k > 0 Then Sh.Range("F2").Resize(k, UBound(daura, 2)).Value = daura
    
    Set MyDic = Nothing
    
End Sub

Hoàng Nhật Phương · 5/4/20

Nguyễn Hoàng Oanh Thơ đã viết:

Xin chào các bạn,
Tôi tải tâp tin và code tại bài này về và thử làm một code sau để học Dictionary... và kết quả không giống như kết quả mẫu.
Tôi gửi code, nhờ các bạn xem và giúp tôi với ạ.

Mã:

Option Explicit

Function LastRowInOneColumn(Sheet As Worksheet, Ten_Cot As String) As Long
    LastRowInOneColumn = Sheet.Cells(Sheet.Rows.Count, Ten_Cot).End(xlUp).Row
End Function

Sub HocDic_1()

    Dim MyDic As Scripting.Dictionary
    Set MyDic = New Scripting.Dictionary
   
    Dim Sh As Worksheet, Key As String
    Dim i As Long, j As Long, k As Long, dongcuoi As Long
    Dim dauvao As Variant, daura As Variant
   
    Set Sh = ThisWorkbook.Worksheets("Sheet1")
   
    dongcuoi = LastRowInOneColumn(Sh, "B")
    If dongcuoi < 2 Then Exit Sub
   
    dauvao = Sh.Range("A2:B" & dongcuoi).Value
   
    ReDim daura(UBound(dauvao, 1), UBound(dauvao, 2))
   
    For i = 1 To UBound(dauvao, 1)
        Key = dauvao(i, 1)
        If MyDic.Exists(Key) = False Then
            k = k + 1
            MyDic.Add Key, k
            For j = 1 To UBound(dauvao, 2)
                daura(k, j) = dauvao(i, j)
            Next j
            Debug.Print daura(k, 1) & "-" & daura(k, 2)
        End If
    Next i
   
    Sh.Range("F2").Resize(100, 2).ClearContents
    Debug.Print "Row:" & k & "-" & "Col:" & UBound(daura, 2)
   
    If k > 0 Then Sh.Range("F2").Resize(k, UBound(daura, 2)).Value = daura
   
    Set MyDic = Nothing
   
End Sub

Xin lỗi mọi người tôi hiểu rồi:
Sửa:
ReDim daura(UBound(dauvao, 1), UBound(dauvao, 2))
Thành:
ReDim daura(1 To UBound(dauvao, 1), 1 To UBound(dauvao, 2))

Hic!

Quang_Hải · 5/4/20

Nguyễn Hoàng Oanh Thơ đã viết:

Xin chào các bạn,
Tôi tải tâp tin và code tại bài này về và thử làm một code sau để học Dictionary... và kết quả không giống như kết quả mẫu.
Tôi gửi code, nhờ các bạn xem và giúp tôi với ạ.

Mã:

Option Explicit

Function LastRowInOneColumn(Sheet As Worksheet, Ten_Cot As String) As Long
    LastRowInOneColumn = Sheet.Cells(Sheet.Rows.Count, Ten_Cot).End(xlUp).Row
End Function

Sub HocDic_1()

    Dim MyDic As Scripting.Dictionary
    Set MyDic = New Scripting.Dictionary
 
    Dim Sh As Worksheet, Key As String
    Dim i As Long, j As Long, k As Long, dongcuoi As Long
    Dim dauvao As Variant, daura As Variant
 
    Set Sh = ThisWorkbook.Worksheets("Sheet1")
 
    dongcuoi = LastRowInOneColumn(Sh, "B")
    If dongcuoi < 2 Then Exit Sub
 
    dauvao = Sh.Range("A2:B" & dongcuoi).Value
 
    ReDim daura(UBound(dauvao, 1), UBound(dauvao, 2))
 
    For i = 1 To UBound(dauvao, 1)
        Key = dauvao(i, 1)
        If MyDic.Exists(Key) = False Then
            k = k + 1
            MyDic.Add Key, k
            For j = 1 To UBound(dauvao, 2)
                daura(k, j) = dauvao(i, j)
            Next j
            Debug.Print daura(k, 1) & "-" & daura(k, 2)
        End If
    Next i
 
    Sh.Range("F2").Resize(100, 2).ClearContents
    Debug.Print "Row:" & k & "-" & "Col:" & UBound(daura, 2)
 
    If k > 0 Then Sh.Range("F2").Resize(k, UBound(daura, 2)).Value = daura
 
    Set MyDic = Nothing
 
End Sub

Có cần thiết phải dùng nguyên cái hàm để lấy dòng cuối không vậy? Trình độ cơ bản mà làm vậy chi? Theo mình thì chỉ tự làm khó mình chứ không ích gì đâu. Tại sao chúng ta phải dùng hàm? Mình nghĩ là khi những dòng code phải viết đi viết lại nhiều lần trong sub thì nên dùng hàm riêng cho gọn code. Góp ý cho vui thôi nhé

Hoàng Nhật Phương · 5/4/20

quanghai1969 đã viết:
Có cần thiết phải dùng nguyên cái hàm để lấy dòng cuối không vậy? Trình độ cơ bản mà làm vậy chi? Theo mình thì chỉ tự làm khó mình chứ không ích gì đâu. Tại sao chúng ta phải dùng hàm? Mình nghĩ là khi những dòng code phải viết đi viết lại nhiều lần trong sub thì nên dùng hàm riêng cho gọn code. Góp ý cho vui thôi nhé

Xin chào anh quanghai1969
Cảm ơn anh đã góp ý cho OT.
OT hay quên không nhớ code nên mới sử dụng cái hàm để lấy dòng cuối, hơn nữa cũng là tập làm quen để kết hợp gọi hàm, gọi thủ tục để quen với code thôi anh ạ. hihi

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

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

Thành viên gắn bó

Thành viên gắn bó

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

Thành viên gắn bó

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

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

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

Thành viên gắn bó

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

Thành viên gắn bó

Thành viên gắn bó

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

File đính kèm

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

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

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

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

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

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

Thành viên thường trực

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

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

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

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

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

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

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ó

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

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ó

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

Thành viên gắn bó

Thành viên gắn bó

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

Thành viên gắn bó

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