Hỏi về ý nghĩa code dùng dictionary

[Yeuvoyeucon]

Kính gửi anh chị và các bạn,
Em ngồi học về Dictionary và có đọc các bài của diễn đàn. Nhưng thực sự em thấy khó hiểu và khó tưởng tượng quá ạ. Anh chị cho em xin ý nghĩa từng đoạn code dưới này với ạ.
+ a = 1 nghĩa là gì ạ
+ Từ đoạn dk = arr(i, 1) & "#" & arr(i, 2) đến hết e không hiểu ạ.

Dim arr, i As Long, dk As String, kq, dic As Object, lr As Long, b As Long, a As Long, j As Long
    Set dic = CreateObject("scripting.dictionary")
    a = 1
    With Sheets("sheet1")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         arr = .Range("A3:D" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 5)
         For i = 1 To UBound(arr)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                dic.Add dk, a
                For j = 1 To 4
                   kq(a, j) = arr(i, j)
                Next j
                kq(a, 5) = "gio vao"
                a = a + 2
             Else
               b = dic.Item(dk) + 1
               For j = 1 To 4
                  kq(b, j) = arr(i, j)
               Next j
               kq(b, 5) = "gio ra"
             End If
        Next i

 

[Ba Tê]

Con có biết là có if r < 4 và cũng biết là sẽ tạo Else... nhưng không biết copy code trong vòng for2 để thế nào ấy chú Mỹ.
Vì sau End if còn nhiều cái khác nữa mà.. như gán dữ liệu vào mảng rồi khai báo thêm...

Tham khảo cách viết này, dựa vào đó xem có thể viết gọn hơn nữa không.

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), tArr(), Txt As String, Ngay1 As Date
Dim I As Long, R As Long, K As Long, K1 As Long, K2 As Long, K3 As Long, Kmax As Long, CoL As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Range("C4", Range("C4").End(xlDown)).Resize(, 7).Value
    Rws = UBound(sArr)
    Ngay1 = Range("K3").Value
ReDim tArr(1 To Rws, 1 To 7)
For I = 1 To Rws
    If sArr(I, 1) = Ngay1 Then
        CoL = 1
    Else
        CoL = 5
    End If
    Txt = sArr(I, 3)
    If Not Dic.Exists(Txt) Then
        K = K + 1
        Dic.Item(Txt) = K
        tArr(K, CoL) = sArr(I, 3)
        tArr(K, CoL + 1) = sArr(I, 4)
        tArr(K, CoL + 2) = sArr(I, 7)
    Else
        R = Dic.Item(Txt)
        tArr(R, CoL + 2) = tArr(R, CoL + 2) + sArr(I, 7)
    End If
Next I
'==========================================='
ReDim dArr(1 To K, 1 To 11)
For I = 1 To K
    If tArr(I, 3) > 0 And tArr(I, 7) = 0 Then
        CoL = 1: K1 = K1 + 1
        dArr(K1, CoL) = tArr(I, 1)
        dArr(K1, CoL + 1) = tArr(I, 2)
        dArr(K1, CoL + 2) = tArr(I, 3)
        If K1 > Kmax Then Kmax = K1
    ElseIf tArr(I, 3) = 0 And tArr(I, 7) > 0 Then
        CoL = 5: K2 = K2 + 1
        dArr(K2, CoL) = tArr(I, 5)
        dArr(K2, CoL + 1) = tArr(I, 6)
        dArr(K2, CoL + 2) = tArr(I, 7)
        If K2 > Kmax Then Kmax = K2
    Else
        CoL = 9: K3 = K3 + 1
        dArr(K3, CoL) = tArr(I, 1)
        dArr(K3, CoL + 1) = tArr(I, 2)
        dArr(K3, CoL + 2) = tArr(I, 7) - tArr(I, 3)
        If K3 > Kmax Then Kmax = K3
    End If
Next I
Range("K5").Resize(Kmax, 11) = dArr
Set Dic = Nothing
End Sub

 

[Hoàng Nhật Phương]

Tham khảo cách viết này, dựa vào đó xem có thể viết gọn hơn nữa không.

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), tArr(), Txt As String, Ngay1 As Date
Dim I As Long, R As Long, K As Long, K1 As Long, K2 As Long, K3 As Long, Kmax As Long, CoL As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Range("C4", Range("C4").End(xlDown)).Resize(, 7).Value
    Rws = UBound(sArr)
    Ngay1 = Range("K3").Value
ReDim tArr(1 To Rws, 1 To 7)
For I = 1 To Rws
    If sArr(I, 1) = Ngay1 Then
        CoL = 1
    Else
        CoL = 5
    End If
    Txt = sArr(I, 3)
    If Not Dic.Exists(Txt) Then
        K = K + 1
        Dic.Item(Txt) = K
        tArr(K, CoL) = sArr(I, 3)
        tArr(K, CoL + 1) = sArr(I, 4)
        tArr(K, CoL + 2) = sArr(I, 7)
    Else
        R = Dic.Item(Txt)
        tArr(R, CoL + 2) = tArr(R, CoL + 2) + sArr(I, 7)
    End If
Next I
'==========================================='
ReDim dArr(1 To K, 1 To 11)
For I = 1 To K
    If tArr(I, 3) > 0 And tArr(I, 7) = 0 Then
        CoL = 1: K1 = K1 + 1
        dArr(K1, CoL) = tArr(I, 1)
        dArr(K1, CoL + 1) = tArr(I, 2)
        dArr(K1, CoL + 2) = tArr(I, 3)
        If K1 > Kmax Then Kmax = K1
    ElseIf tArr(I, 3) = 0 And tArr(I, 7) > 0 Then
        CoL = 5: K2 = K2 + 1
        dArr(K2, CoL) = tArr(I, 5)
        dArr(K2, CoL + 1) = tArr(I, 6)
        dArr(K2, CoL + 2) = tArr(I, 7)
        If K2 > Kmax Then Kmax = K2
    Else
        CoL = 9: K3 = K3 + 1
        dArr(K3, CoL) = tArr(I, 1)
        dArr(K3, CoL + 1) = tArr(I, 2)
        dArr(K3, CoL + 2) = tArr(I, 7) - tArr(I, 3)
        If K3 > Kmax Then Kmax = K3
    End If
Next I
Range("K5").Resize(Kmax, 11) = dArr
Set Dic = Nothing
End Sub

Con chào Thầy, cảm ơn Thầy đã gợi ý cho con.
Cách của Thầy nhìn gọn hơn: vòng For 2 chạy ngắn hơn, gộp 3 mảng kết quả vào 1 mảng.

 

[ptm0412]

Con chào Thầy, cảm ơn Thầy đã gợi ý cho con.
Cách của Thầy nhìn gọn hơn: vòng For 2 chạy ngắn hơn, gộp 3 mảng kết quả vào 1 mảng.

Nhưng có hiểu không ấy chứ? Code lão ấy gọn nhưng:
- khó hiểu
- Nếu dữ liệu nhiều ngày trải dài cả tháng cả năm thì sai

Theo thuật toán của nhóc thì cũng 2 vòng lặp, Dic add nhiều lần, nhưng dễ đọc dễ hiểu hơn

Sub DicPtm()

    Dim data(), res1(), res2(), res3()
    Dim sNgayTruoc As String, sNgaySau As String, sKey As String
    Dim r As Long, iK As Long, k1 As Long, k2 As Long, k3 As Long
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("DATA")
        r = .Cells(.Rows.Count, "C").End(xlUp).Row
        If r < 4 Then
            Exit Sub
        Else
            data = .Range("C4:I" & r).Value
            ReDim res1(1 To UBound(data, 1), 1 To 3)
            ReDim res2(1 To UBound(data, 1), 1 To 3)
            ReDim res3(1 To UBound(data, 1), 1 To 3)
            For r = LBound(data, 1) To UBound(data, 1)
                sKey = data(r, 1) & "|" & data(r, 3) & "|" & data(r, 4)
                If Not dic.Exists(sKey) Then dic.Add sKey, r
            Next
            For r = LBound(data, 1) To UBound(data, 1)
                sKey = data(r, 1) & "|" & data(r, 3) & "|" & data(r, 4)
                sNgayTruoc = .Range("K3") & "|" & data(r, 3) & "|" & data(r, 4)
                sNgaySau = .Range("O3") & "|" & data(r, 3) & "|" & data(r, 4)
                If sKey = sNgayTruoc And Not dic.Exists(sNgaySau) Then
                    If Not dic.Exists(sNgayTruoc & "|kq1") Then
                        k1 = k1 + 1
                        dic.Add (sNgayTruoc & "|kq1"), k1
                    End If
                    rk1 = dic.Item(sNgayTruoc & "|kq1")
                    res1(rk1, 1) = data(r, 3)
                    res1(rk1, 2) = data(r, 4)
                    res1(rk1, 3) = res1(rk1, 3) + data(r, 7)
                ElseIf sKey = sNgaySau And Not dic.Exists(sNgayTruoc) Then
                    If Not dic.Exists(sNgaySau & "|kq2") Then
                        k2 = k2 + 1
                        dic.Add (sNgaySau & "|kq2"), k2
                    End If
                    rk2 = dic.Item(sNgaySau & "|kq2")
                    res2(rk2, 1) = data(r, 3)
                    res2(rk2, 2) = data(r, 4)
                    res2(rk2, 3) = res2(rk2, 3) + data(r, 7)
                ElseIf sKey = sNgayTruoc And dic.Exists(sNgaySau) Then
                    If Not dic.Exists(sNgayTruoc & "|kq3") Then
                        k3 = k3 + 1
                        dic.Add (sNgayTruoc & "|kq3"), k3
                    End If
                    rk3 = dic.Item(sNgayTruoc & "|kq3")
                    res3(rk3, 1) = data(r, 3)
                    res3(rk3, 2) = data(r, 4)
                    res3(rk3, 3) = res3(rk3, 3) - data(r, 7)
                ElseIf sKey = sNgaySau And dic.Exists(sNgayTruoc) Then
                    rk3 = dic.Item(sNgayTruoc & "|kq3")
                    res3(rk3, 3) = res3(rk3, 3) + data(r, 7)
                End If
            Next r
        End If
        .Range("K5").Resize(100, 11).ClearContents
        If k1 > 0 Then .Range("K5").Resize(k1, 3).Value = res1
        If k2 > 0 Then .Range("O5").Resize(k2, 3).Value = res2
        If k3 > 0 Then .Range("S5").Resize(50, 3).Value = res3
        
    End With
    
    Set dic = Nothing
    
End Sub

 

[Hoàng Nhật Phương]

Nhưng có hiểu không ấy chứ? Code lão ấy gọn nhưng:
- khó hiểu
- Nếu dữ liệu nhiều ngày trải dài cả tháng cả năm thì sai

Theo thuật toán của nhóc thì cũng 2 vòng lặp, Dic add nhiều lần, nhưng dễ đọc dễ hiểu hơn

Sub DicPtm()

    Dim data(), res1(), res2(), res3()
    Dim sNgayTruoc As String, sNgaySau As String, sKey As String
    Dim r As Long, iK As Long, k1 As Long, k2 As Long, k3 As Long
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("DATA")
        r = .Cells(.Rows.Count, "C").End(xlUp).Row
        If r < 4 Then
            Exit Sub
        Else
            data = .Range("C4:I" & r).Value
            ReDim res1(1 To UBound(data, 1), 1 To 3)
            ReDim res2(1 To UBound(data, 1), 1 To 3)
            ReDim res3(1 To UBound(data, 1), 1 To 3)
            For r = LBound(data, 1) To UBound(data, 1)
                sKey = data(r, 1) & "|" & data(r, 3) & "|" & data(r, 4)
                If Not dic.Exists(sKey) Then dic.Add sKey, r
            Next
            For r = LBound(data, 1) To UBound(data, 1)
                sKey = data(r, 1) & "|" & data(r, 3) & "|" & data(r, 4)
                sNgayTruoc = .Range("K3") & "|" & data(r, 3) & "|" & data(r, 4)
                sNgaySau = .Range("O3") & "|" & data(r, 3) & "|" & data(r, 4)
                If sKey = sNgayTruoc And Not dic.Exists(sNgaySau) Then
                    If Not dic.Exists(sNgayTruoc & "|kq1") Then
                        k1 = k1 + 1
                        dic.Add (sNgayTruoc & "|kq1"), k1
                    End If
                    rk1 = dic.Item(sNgayTruoc & "|kq1")
                    res1(rk1, 1) = data(r, 3)
                    res1(rk1, 2) = data(r, 4)
                    res1(rk1, 3) = res1(rk1, 3) + data(r, 7)
                ElseIf sKey = sNgaySau And Not dic.Exists(sNgayTruoc) Then
                    If Not dic.Exists(sNgaySau & "|kq2") Then
                        k2 = k2 + 1
                        dic.Add (sNgaySau & "|kq2"), k2
                    End If
                    rk2 = dic.Item(sNgaySau & "|kq2")
                    res2(rk2, 1) = data(r, 3)
                    res2(rk2, 2) = data(r, 4)
                    res2(rk2, 3) = res2(rk2, 3) + data(r, 7)
                ElseIf sKey = sNgayTruoc And dic.Exists(sNgaySau) Then
                    If Not dic.Exists(sNgayTruoc & "|kq3") Then
                        k3 = k3 + 1
                        dic.Add (sNgayTruoc & "|kq3"), k3
                    End If
                    rk3 = dic.Item(sNgayTruoc & "|kq3")
                    res3(rk3, 1) = data(r, 3)
                    res3(rk3, 2) = data(r, 4)
                    res3(rk3, 3) = res3(rk3, 3) - data(r, 7)
                ElseIf sKey = sNgaySau And dic.Exists(sNgayTruoc) Then
                    rk3 = dic.Item(sNgayTruoc & "|kq3")
                    res3(rk3, 3) = res3(rk3, 3) + data(r, 7)
                End If
            Next r
        End If
        .Range("K5").Resize(100, 11).ClearContents
        If k1 > 0 Then .Range("K5").Resize(k1, 3).Value = res1
        If k2 > 0 Then .Range("O5").Resize(k2, 3).Value = res2
        If k3 > 0 Then .Range("S5").Resize(50, 3).Value = res3
      
    End With
  
    Set dic = Nothing
  
End Sub

chú Mỹ đã xuất code
Nhưng mà hơi nhanh ẩu : rk1,rk2,rk3 chú Mỹ không định nghĩa.
và: .Range("S5").Resize(50, 3).Value = res3
------------
Qua cách làm của Thầy @Ba Tê và chú @ptm0412 (những người có kiến thức sâu rộng về code) con kết luận vẫn phải sử dụng 2 For cho bài này hehe

 

[ptm0412]

chú Mỹ đã xuất code
Nhưng mà hơi nhanh ẩu : rk1,rk2,rk3 chú Mỹ không định nghĩa.
và: .Range("S5").Resize(50, 3).Value = res3

Con 50 đỏ là do thí nghiệm và chưa sửa lại, còn không khai báo biến máy chú không bắt lỗi.

 

[Ba Tê]

- khó hiểu
- Nếu dữ liệu nhiều ngày trải dài cả tháng cả năm thì sai

- Khó hiểu: Gán mảng tArr() vào chỗ nào đó xem sẽ thành dễ hiểu.
Ví dụ: Range("K20").Resize(K, 7) = tArr
- Nếu dữ liệu nhiều ngày trải dài cả tháng cả năm thì sai.
Thêm biến Ngay2:

Ngay2 = Range("O3").Value
ReDim tArr(1 To Rws, 1 To 7)
For I = 1 To Rws
    If sArr(I, 1) = Ngay1 Or sArr(I, 1) = Ngay2 Then
        If sArr(I, 1) = Ngay1 Then
            CoL = 1
        Else
            CoL = 5
        End If
    ..........................

 

[Hoàng Nhật Phương]

Cũng có một bài toán về tính toán theo định mức tôi thấy cũng rất hay để vận dụng DIC ở đây , các bạn có thể tham khảo.
--------
Chú Mỹ @ptm0412 rỗi hơi không ạ? Chú cho con thêm một cách để con tham khảo với ạ.

 

[ptm0412]

Chú Mỹ @ptm0412 rỗi hơi không ạ? Chú cho con thêm một cách để con tham khảo với ạ.

Bài đó dữ liệu không chuẩn, không có hứng làm.

 

[ptm0412]

Bài đó dữ liệu không chuẩn, không có hứng làm.

Đại khái dữ liệu chuẩn của tính định mức là trong bài này Liệt kê hết NVL sản xuất

 

[batman1]

Kính gửi anh chị và các bạn,
Em ngồi học về Dictionary và có đọc các bài của diễn đàn. Nhưng thực sự em thấy khó hiểu và khó tưởng tượng quá ạ. Anh chị cho em xin ý nghĩa từng đoạn code dưới này với ạ.
+ a = 1 nghĩa là gì ạ
+ Từ đoạn dk = arr(i, 1) & "#" & arr(i, 2) đến hết e không hiểu ạ.

Cách dùng dictionary quá sơ đẳng nên không thể nói là không hiểu.

Theo tôi bạn không hiểu thuật toán chứ không phải là không hiểu cách dùng dictionary. Thuật toán là thuật toán, nó là "hướng đi", là "các bước đi cơ bản" cần thực hiện để giải quyết một bài toán.

Thuật toán có thể phát biểu bằng lời, bằng sơ đồ khối ... Anh A implement thuật toán trong vd. Delphi, dùng các "công cụ" của Delphi. Anh B cũng implement thuật toán đó nhưng trong VBA, và dùng các công cụ của VBA. Dictionary kia chẳng qua là "công cụ" dùng khi implement thuật toán.
Tôi cũng implement thuật toán kia nhưng không dùng "công cụ" Dictionary mà dùng "công cụ" FOR

Sub test()
Dim Arr, i As Long, dk As String, kq, dieukien(), lr As Long, b As Long, a As Long, j As Long, count As Long
    a = 1
    With Sheets("sheet1")
         lr = .Range("A" & Rows.count).End(xlUp).Row
         If lr < 3 Then Exit Sub
         Arr = .Range("A3:D" & lr).Value
         ReDim kq(1 To UBound(Arr), 1 To 5)
         count = 1
         ReDim dieukien(1 To 2, 1 To count)
         For i = 1 To UBound(Arr)
             dk = Arr(i, 1) & "#" & Arr(i, 2)
             
             For j = 1 To count    ' kiểm tra xem dk đã từng xuất hiện trước đó hay chưa - dùng FOR
                If dieukien(1, j) = dk Then Exit For
             Next j
             
             If j > count Then  ' chưa xuất hiện dk lần nào
                count = count + 1
                ReDim Preserve dieukien(1 To 2, 1 To count)
                dieukien(1, count) = dk
                dieukien(2, count) = a
                
                For j = 1 To 4
                   kq(a, j) = Arr(i, j)
                Next j
                kq(a, 5) = "gio vao"
                a = a + 2
             Else
               b = dieukien(2, j)
               For j = 1 To 4
                  kq(b, j) = Arr(i, j)
               Next j
               kq(b, 5) = "gio ra"
             End If
        Next i
    End With
End Sub

Code trên và code của tác giả "tương đương" nhau (nếu tôi không nhầm nhẫn khi viết). Nếu bạn hiểu code trên thì cũng phải hiểu code dùng dictionary, vì dictionary chỉ được dùng sơ đẳng để kiểm tra một dk đã từng xuất hiện trước đó hay chưa. Nếu code trên cũng không hiểu thì chứng tỏ là bạn không hiểu thuật toán. Vì code trên không dùng dictionary nên không thể đổ lỗi cho dictionary là nó khó.