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

Liên hệ QC
Y

Yeuvoyeucon

Thành viên hoạt động
Tham gia
30/10/09
Bài viết
143
Được thích
23
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 ạ.
Mã: 
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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Hoàng Nhật Phương đã viế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...
Nhấp chuột vào đây để mở rộ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.
PHP: 
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
 
Upvote 0
Ba Tê đã viết:
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.
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
Hoàng Nhật Phương đã viết:
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ấp chuột vào đây để mở rộ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
PHP: 
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
 
Upvote 0
ptm0412 đã viết:
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
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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 --=0
 
Upvote 0
Upvote 0
ptm0412 đã viế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
Nhấp chuột vào đây để mở rộng...
- 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:
PHP: 
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
    ..........................
 
Lần chỉnh sửa cuối:
Upvote 0
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 ạ.
 
Upvote 0
Yeuvoyeucon đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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
Mã: 
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ó.
 
Upvote 1
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

M
Free connections, find your partner without obligations
Trả lời
0
Đọc
1
minh2711
M
V
  • Question
GIúp code xóa các tên mặt hàng trùng nhau, chỉ chừa lại tên cho dòng trên cùng
Trả lời
1
Đọc
23
BuiQuangThuan
B
Hoangquyenbong
  • Question
Lấy hệ số tương ứng cho mã hàng xuất.
Trả lời
2
Đọc
62
Hoangquyenbong
Hoangquyenbong
H
Tính tổng có điều kiện
2
Trả lời
22
Đọc
428
hoaiantrinh
H
L
[xin nhờ giúp đỡ] hàm trích xuất ra dữ liệu thỏa mã điều kiện và ghi vào một ô
Trả lời
12
Đọc
482
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom