Hỏi về ý nghĩa code dùng dictionary (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề nà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
 
Kiếm đoạn dic khác chân phương hơn 1 chút chứ đoạn này hơi khó chút xíu.
 
Upvote 0
Kiếm đoạn dic khác chân phương hơn 1 chút chứ đoạn này hơi khó chút xíu.
File nó đây anh ạ. File ở diễn đàn mình ạ. Nếu theo tư duy bình thường thì với mỗi nhân viên trong một ngày tìm giờ min và giờ max và list ra ạ. Nhưng em đọc code không hiểu chỗ nào nó làm kiểu đó, hay là một giải thuật khác ạ. Mong anh chỉ giúp ạ.
 

File đính kèm

Upvote 0
File nó đây anh ạ. File ở diễn đàn mình ạ. Nếu theo tư duy bình thường thì với mỗi nhân viên trong một ngày tìm giờ min và giờ max và list ra ạ. Nhưng em đọc code không hiểu chỗ nào nó làm kiểu đó, hay là một giải thuật khác ạ. Mong anh chỉ giúp ạ.
Lúc nào trên máy tính tôi sẽ cho 1 ví dụ dễ hiểu hơn đối với bạn. Hiểu cái đơn giản rồi mới dần dần lấn tới.
 
Upvote 0
@Yeuvoyeucon Bạn xem bài viết hướng dẫn này xem
 
Upvote 0
@Yeuvoyeucon Bạn xem bài viết hướng dẫn này xem
Dạ, mình đọc rồi bạn ạ. Toàn cái hay. Nhưng đi vào thực tế mình đọc mình không hiểu hết được. Nhiều khi có thuật toán giải khác so với tư duy thông thường của mình.
 
Upvote 0
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
Bỏ lấy cái đấy đi để hiểu,

1) Nên học lại cơ bản VBA , vì không hiểu
a=1
thì hiểu dictionary object chi cho vội

2) sau khi hiểu VBA cơ bản thì tìm kiếm Dictionary cơ bản mà đọc
 
Upvote 0
Bỏ lấy cái đấy đi để hiểu,

1) Nên học lại cơ bản VBA , vì không hiểu
a=1
thì hiểu dictionary object chi cho vội

2) sau khi hiểu VBA cơ bản thì tìm kiếm Dictionary cơ bản mà đọc
Cách học của người đi làm và có tuổi sẽ khác với người trẻ bạn ạ. Học ngoại ngữ cũng thế thôi, người đi làm học ngoại ngữ cũng có cách học riêng để đốt nhanh giai đoạn ở đoạn nào đó. Mỗi người một cách học và nhu cầu tùy theo điều kiện và thời gian. Mình ở cơ quan chủ yếu dùng SQL còn VBA mình có biết tý chút nhưng mình đang tìm hiểu về Dic và với mình nó là cái khó, nên mình mới hỏi.
 
Upvote 0
File nó đây anh ạ. File ở diễn đàn mình ạ. Nếu theo tư duy bình thường thì với mỗi nhân viên trong một ngày tìm giờ min và giờ max và list ra ạ. Nhưng em đọc code không hiểu chỗ nào nó làm kiểu đó, hay là một giải thuật khác ạ. Mong anh chỉ giúp ạ.

File này của bạn chỉ chạy đúng khi dữ liệu ngày giờ đã được sắp xếp tăng dần, nếu không có sắp xếp sẽ chạy sai giờ vào/ ra.
 
Upvote 0
Đây là diễn đạt theo cách mình hiểu, thuật ngữ nhiều khi không rành lắm, bạn cứ xem lại cái cơ bản trên diễn đàn nhiều lắm là sẽ hiểu hơn. "Văn viết" ra nhiều khi bạn đọc xong cũng không hiểu, có người giảng thì dễ hiểu hơn.
Dim arr, i As Long, dk As String, kq, dic As Object, lr As Long, b As Long, a As Long, j As Long 'khai báo biến
Set dic = CreateObject("scripting.dictionary") 'tạo đối tượng Dictionary
a = 1 ‘mặc định giá trị bắt đầu của biến a là 1
With Sheets("sheet1") 'tại sheet1
lr = .Range("A" & Rows.Count).End(xlUp).Row ‘Xác định biến lr = vị trí dòng cuối cùng có dữ liệu tại cột A
If lr < 3 Then Exit Sub ‘nếu biến lr nhỏ hơn 3 (dữ liệu bên dưới hàng tiêu đề không có thì thoát sub không thực hiện tiếp nữa)
arr = .Range("A3:D" & lr).Value ‘nạp vùng từ A3 đến cột D hàng cuối cùng có dữ liệu tại cột A (lr)
ReDim kq(1 To UBound(arr), 1 To 5) ‘xác định lại kích thước cho mảng kq (gồm số hàng = số phần tử từ A3:A & lr, số cột = 5 cột)
For i = 1 To UBound(arr) ‘vòng lặp chạy từ 1 đến giá trị cuối cùng tại cột đầu tiên của mảng arr
dk = arr(i, 1) & "#" & arr(i, 2) ‘biến dk là chuỗi ghép từ 2 cột A và B, dấu # để phân biệt sự khác nhau giữa "abc_def" va "ab_cdef" khi nối chuỗi lại
If Not dic.exists(dk) Then ‘phương thức exists kiểm tra sự tồn tại của khóa dk, nếu “not” là chưa có khóa này trong dic thì thực hiện tiếp
dic.Add dk, a ‘phương thức add sẽ đánh dấu key cho biến dk là a lúc này có giá trị a=1
For j = 1 To 4 ‘vòng for chạy từ 1 đến 4 tương ứng với 4 cột của mảng kq và mảng arr
kq(a, j) = arr(i, j) ‘mảng kq = mảng arr (giá trị tương ứng vị trí hàng thứ 1 trong mảng và cột 1,2,3,4)
Next j
kq(a, 5) = "gio vao" ‘ghi chú cột thứ 5 của mảng tại dòng thứ a là “gio vao”
a = a + 2 ‘thay đổi giá trị của a tăng thêm 2 dòng (để dòng bên dưới sẽ ghi "giờ ra")
Else ‘ngược lại điều kiện if trên là xét khóa dk nếu lặp lại (đã tồn tại key ghi nhớ ở mệnh đề if trên rồi)
b = dic.Item(dk) + 1 ‘lúc này biến b sẽ bằng key đã ghi nhớ của biến dk tăng thêm 1 (nghĩa là vòng lặp For xét có bao nhiêu dòng giờ ra trong ngày thì hàng tính giờ ra sau cùng sẽ ghi vào mảng bên dưới hàng "giờ vào")
For j = 1 To 4 ‘tương tự như trên
kq(b, j) = arr(i, j) ‘tương tự như trên
Next j 'kết thúc vòng lặp
kq(b, 5) = "gio ra" ‘ghi chú cột thứ 5 của mảng tại dòng b là “gio ra”
End If 'kết thúc if
Next i
... chắc còn phần code ghi mảng ra sheet tại vị trí nào nữa là xong.
 
Upvote 0
Mong anh cho ý nghĩa của các dòng trong code và thuật toán của code với ạ.

Mình giải thích theo cách hiểu của bản thân, bạn tham khảo:

1628927246718.png
1628927285673.png

Mã:
Option Explicit

Sub laydulieu()
    '//Khai baìo biêìn
    Dim arr, i As Long, dk As String, kq, dic As Object, lr As Long, b As Long, a As Long, j As Long
    '//KhõÒi taòo Dic
    Set dic = CreateObject("scripting.dictionary")
    
    a = 1 'a bãìt ðâÌu = 1 , doÌng ðâÌu tiên trong maÒng kq
    With Sheets("sheet1")
        '//Xaìc ðiònh doÌng cuôìi trong baÒng dýÞ liêòu cãn cýì vaÌo côòt A ðêÒ xaìc ðiònh
         lr = .Range("A" & Rows.Count).End(xlUp).Row
        
         '// nêìu doÌng cuôìi < 3 không coì dýÞ liêòu thiÌ thoaìt câu lêònh
         If lr < 3 Then Exit Sub
        
         '// gaìn dýÞ liêòu vaÌo baÒng bãìt ðâÌu týÌ côòt A doÌng 3 ðêìn côòt B doÌng Lr(tiÌm ðýõòc)
         arr = .Range("A3:D" & lr).Value
        
         'khai baìo maÒng kq ðêÒ gaìn kêìt quaÒ võìi chiêÌu thýì nhâìt = maÒng ar, chiêÌu thýì 2 (5 côòt)
         ReDim kq(1 To UBound(arr), 1 To 5)
        
         For i = 1 To UBound(arr) '//Duyêòt caìc lâÌn lýõòt theo chiêÌu thýì nhâìt
            
             '//xaìc ðiònh ðiêÌu kiêòn câÌn ðýa vaÌo dic
             dk = arr(i, 1) & "#" & arr(i, 2) '//NgaÌy thaìng + IdNumber
             '"#" ðêÒ phân biêòt trong trýõÌng hõòp nôìi 2 chuôÞi laòi biò truÌng nhau, viì duò:
             '  "abc" & "def" = "abcdef" -->      chuôÞi 1
             '  "ab"  &  "cdef"= "abcdef" -->     chuôÞi 2
             ' => chuôÞi 1 = chuôÞi 2  cuÌng laÌ "abcdef" nêìu gaìn vaÌo dic thiÌ chiÒ châìp nhâòn ðýõòc 1 giaì triò.
             ' do ðoì nêìu muôìn phân biêòt 2 chuôÞi gheìp naÌy thiÌ câÌn gaìn môòt hoãòc chuôÞi kyì týò ðãòc biêòt ðêÒ phân biêòt 2 chuôÞi
             '  "abc" & "#" & "def" = "abc#def" -->      chuôÞi 1
             '  "ab" & "#" &  "cdef"= "ab#cdef" -->      chuôÞi 2
            
             If Not dic.exists(dk) Then '//nêìu chuôÞi dk chýa tôÌn taòi trong dic
                dic.Add dk, a '// ðýa chuôÞi dk vaÌo dic , týõng ýìng võìi doÌng dýÞ liêòu a trong maÒng kq
                For j = 1 To 4 'Duyêòt 4 côòt trong maÒng, týõng ýìng 4 côòt A,B,C,D trên baÒng tiình
                   kq(a, j) = arr(i, j) ' bãìt ðâÌu gaìn vaÌo doÌng a trong maÒng kq (kêìt quaÒ) ,
                   '//lâÌn lýõòt týÌ côòt 1 ðêìn côòt 4
                Next j
                kq(a, 5) = "gio vao" ' côòt thýì 5 trong maÒng kêìt quaÒ gaìn "gio vao"
                a = a + 2 'nhaÒy caìch doÌng(caìch 1 doÌng)sau môÞi lâÌn tiÌm ðýõòc kêìt quaÒ dk duy nhâìt a tãng 2 giaì triò
                
             Else
               b = dic.Item(dk) + 1 ' nêìu truÌng ngaÌy vaÌ IdNuber thiÌ xaìc ðiònh doÌng dýÞ liêòu truÌng trong maÒng kq (a),
               'khi xaìc ðiònh ðýõòc doÌng truÌng thiÌ + 1 (gaìn giaì triò vaÌo ngay doÌng bên dýõìi )
               'nêìu õÒ trên caìc giaì triò gaìn vaÌo doÌng a thiÌ õÒ ðây seÞ laÌ a+1
               For j = 1 To 4 '// duyêòt 4 côòt nhý trên vaÌ gaìn giaì triò lâÌn lýõòt
                  kq(b, j) = arr(i, j)
               Next j
               kq(b, 5) = "gio ra" ' côòt thýì 5 trong maÒng kêìt quaÒ gaìn "gio ra" týõng ýìng laÌ a+1
             End If
        Next i
        '//Xaìc ðiònh doÌng cuôìi trong baÒng dýÞ liêòu cãn cýì vaÌo côòt I ðêÒ xaìc ðiònh
        lr = .Range("I" & Rows.Count).End(xlUp).Row
        
        If lr > 2 Then .Range("I3:M" & lr).ClearContents '//Nêìu coì dýÞ liêòu thiÌ xoìa
        
        'nêìu > 0 : caìi naÌy laÌ thýÌa a luôn >0 viÌ a bãìt ðâÌu =1
        If a Then .Range("I3:M3").Resize(a - 1).Value = kq ' gaìn dýÞ liêòu trong maÒng kq xuôìng sheet
        
   End With

End Sub
 
Upvote 0
Đây là diễn đạt theo cách mình hiểu, thuật ngữ nhiều khi không rành lắm, bạn cứ xem lại cái cơ bản trên diễn đàn nhiều lắm là sẽ hiểu hơn. "Văn viết" ra nhiều khi bạn đọc xong cũng không hiểu, có người giảng thì dễ hiểu hơn.
Dim arr, i As Long, dk As String, kq, dic As Object, lr As Long, b As Long, a As Long, j As Long 'khai báo biến
Set dic = CreateObject("scripting.dictionary") 'tạo đối tượng Dictionary
a = 1 ‘mặc định giá trị bắt đầu của biến a là 1
With Sheets("sheet1") 'tại sheet1
lr = .Range("A" & Rows.Count).End(xlUp).Row ‘Xác định biến lr = vị trí dòng cuối cùng có dữ liệu tại cột A
If lr < 3 Then Exit Sub ‘nếu biến lr nhỏ hơn 3 (dữ liệu bên dưới hàng tiêu đề không có thì thoát sub không thực hiện tiếp nữa)
arr = .Range("A3:D" & lr).Value ‘nạp vùng từ A3 đến cột D hàng cuối cùng có dữ liệu tại cột A (lr)
ReDim kq(1 To UBound(arr), 1 To 5) ‘xác định lại kích thước cho mảng kq (gồm số hàng = số phần tử từ A3:A & lr, số cột = 5 cột)
For i = 1 To UBound(arr) ‘vòng lặp chạy từ 1 đến giá trị cuối cùng tại cột đầu tiên của mảng arr
dk = arr(i, 1) & "#" & arr(i, 2) ‘biến dk là chuỗi ghép từ 2 cột A và B, dấu # để phân biệt sự khác nhau giữa "abc_def" va "ab_cdef" khi nối chuỗi lại
If Not dic.exists(dk) Then ‘phương thức exists kiểm tra sự tồn tại của khóa dk, nếu “not” là chưa có khóa này trong dic thì thực hiện tiếp
dic.Add dk, a ‘phương thức add sẽ đánh dấu key cho biến dk là a lúc này có giá trị a=1
For j = 1 To 4 ‘vòng for chạy từ 1 đến 4 tương ứng với 4 cột của mảng kq và mảng arr
kq(a, j) = arr(i, j) ‘mảng kq = mảng arr (giá trị tương ứng vị trí hàng thứ 1 trong mảng và cột 1,2,3,4)
Next j
kq(a, 5) = "gio vao" ‘ghi chú cột thứ 5 của mảng tại dòng thứ a là “gio vao”
a = a + 2 ‘thay đổi giá trị của a tăng thêm 2 dòng (để dòng bên dưới sẽ ghi "giờ ra")
Else ‘ngược lại điều kiện if trên là xét khóa dk nếu lặp lại (đã tồn tại key ghi nhớ ở mệnh đề if trên rồi)
b = dic.Item(dk) + 1 ‘lúc này biến b sẽ bằng key đã ghi nhớ của biến dk tăng thêm 1 (nghĩa là vòng lặp For xét có bao nhiêu dòng giờ ra trong ngày thì hàng tính giờ ra sau cùng sẽ ghi vào mảng bên dưới hàng "giờ vào")
For j = 1 To 4 ‘tương tự như trên
kq(b, j) = arr(i, j) ‘tương tự như trên
Next j 'kết thúc vòng lặp
kq(b, 5) = "gio ra" ‘ghi chú cột thứ 5 của mảng tại dòng b là “gio ra”
End If 'kết thúc if
Next i
... chắc còn phần code ghi mảng ra sheet tại vị trí nào nữa là xong.
Cảm ơn bạn đã đọc và chỉ bảo. Mình sẽ đọc kỹ !
 
Upvote 0
Cách học của người đi làm và có tuổi sẽ khác với người trẻ bạn ạ. Học ngoại ngữ cũng thế thôi, người đi làm học ngoại ngữ cũng có cách học riêng để đốt nhanh giai đoạn ở đoạn nào đó. Mỗi người một cách học và nhu cầu tùy theo điều kiện và thời gian. Mình ở cơ quan chủ yếu dùng SQL còn VBA mình có biết tý chút nhưng mình đang tìm hiểu về Dic và với mình nó là cái khó, nên mình mới hỏi.
Bạn xem file ví dụ và giải thích từng dòng code trong đó
 

File đính kèm

Upvote 1
Mình giải thích theo cách hiểu của bản thân, bạn tham khảo:

View attachment 264074
View attachment 264075

Mã:
Option Explicit

Sub laydulieu()
    '//Khai baìo biêìn
    Dim arr, i As Long, dk As String, kq, dic As Object, lr As Long, b As Long, a As Long, j As Long
    '//KhõÒi taòo Dic
    Set dic = CreateObject("scripting.dictionary")
   
    a = 1 'a bãìt ðâÌu = 1 , doÌng ðâÌu tiên trong maÒng kq
    With Sheets("sheet1")
        '//Xaìc ðiònh doÌng cuôìi trong baÒng dýÞ liêòu cãn cýì vaÌo côòt A ðêÒ xaìc ðiònh
         lr = .Range("A" & Rows.Count).End(xlUp).Row
       
         '// nêìu doÌng cuôìi < 3 không coì dýÞ liêòu thiÌ thoaìt câu lêònh
         If lr < 3 Then Exit Sub
       
         '// gaìn dýÞ liêòu vaÌo baÒng bãìt ðâÌu týÌ côòt A doÌng 3 ðêìn côòt B doÌng Lr(tiÌm ðýõòc)
         arr = .Range("A3:D" & lr).Value
       
         'khai baìo maÒng kq ðêÒ gaìn kêìt quaÒ võìi chiêÌu thýì nhâìt = maÒng ar, chiêÌu thýì 2 (5 côòt)
         ReDim kq(1 To UBound(arr), 1 To 5)
       
         For i = 1 To UBound(arr) '//Duyêòt caìc lâÌn lýõòt theo chiêÌu thýì nhâìt
           
             '//xaìc ðiònh ðiêÌu kiêòn câÌn ðýa vaÌo dic
             dk = arr(i, 1) & "#" & arr(i, 2) '//NgaÌy thaìng + IdNumber
             '"#" ðêÒ phân biêòt trong trýõÌng hõòp nôìi 2 chuôÞi laòi biò truÌng nhau, viì duò:
             '  "abc" & "def" = "abcdef" -->      chuôÞi 1
             '  "ab"  &  "cdef"= "abcdef" -->     chuôÞi 2
             ' => chuôÞi 1 = chuôÞi 2  cuÌng laÌ "abcdef" nêìu gaìn vaÌo dic thiÌ chiÒ châìp nhâòn ðýõòc 1 giaì triò.
             ' do ðoì nêìu muôìn phân biêòt 2 chuôÞi gheìp naÌy thiÌ câÌn gaìn môòt hoãòc chuôÞi kyì týò ðãòc biêòt ðêÒ phân biêòt 2 chuôÞi
             '  "abc" & "#" & "def" = "abc#def" -->      chuôÞi 1
             '  "ab" & "#" &  "cdef"= "ab#cdef" -->      chuôÞi 2
           
             If Not dic.exists(dk) Then '//nêìu chuôÞi dk chýa tôÌn taòi trong dic
                dic.Add dk, a '// ðýa chuôÞi dk vaÌo dic , týõng ýìng võìi doÌng dýÞ liêòu a trong maÒng kq
                For j = 1 To 4 'Duyêòt 4 côòt trong maÒng, týõng ýìng 4 côòt A,B,C,D trên baÒng tiình
                   kq(a, j) = arr(i, j) ' bãìt ðâÌu gaìn vaÌo doÌng a trong maÒng kq (kêìt quaÒ) ,
                   '//lâÌn lýõòt týÌ côòt 1 ðêìn côòt 4
                Next j
                kq(a, 5) = "gio vao" ' côòt thýì 5 trong maÒng kêìt quaÒ gaìn "gio vao"
                a = a + 2 'nhaÒy caìch doÌng(caìch 1 doÌng)sau môÞi lâÌn tiÌm ðýõòc kêìt quaÒ dk duy nhâìt a tãng 2 giaì triò
               
             Else
               b = dic.Item(dk) + 1 ' nêìu truÌng ngaÌy vaÌ IdNuber thiÌ xaìc ðiònh doÌng dýÞ liêòu truÌng trong maÒng kq (a),
               'khi xaìc ðiònh ðýõòc doÌng truÌng thiÌ + 1 (gaìn giaì triò vaÌo ngay doÌng bên dýõìi )
               'nêìu õÒ trên caìc giaì triò gaìn vaÌo doÌng a thiÌ õÒ ðây seÞ laÌ a+1
               For j = 1 To 4 '// duyêòt 4 côòt nhý trên vaÌ gaìn giaì triò lâÌn lýõòt
                  kq(b, j) = arr(i, j)
               Next j
               kq(b, 5) = "gio ra" ' côòt thýì 5 trong maÒng kêìt quaÒ gaìn "gio ra" týõng ýìng laÌ a+1
             End If
        Next i
        '//Xaìc ðiònh doÌng cuôìi trong baÒng dýÞ liêòu cãn cýì vaÌo côòt I ðêÒ xaìc ðiònh
        lr = .Range("I" & Rows.Count).End(xlUp).Row
       
        If lr > 2 Then .Range("I3:M" & lr).ClearContents '//Nêìu coì dýÞ liêòu thiÌ xoìa
       
        'nêìu > 0 : caìi naÌy laÌ thýÌa a luôn >0 viÌ a bãìt ðâÌu =1
        If a Then .Range("I3:M3").Resize(a - 1).Value = kq ' gaìn dýÞ liêòu trong maÒng kq xuôìng sheet
       
   End With

End Sub
Cảm ơn OT đã trợ giúp. Mong bạn luôn bình an !
 
Upvote 0
Bạn xem file ví dụ và giải thích từng dòng code trong đó
Ví dụ của em đúng như anh Ongke0711 nói thì nếu không xếp theo thứ tự tăng dần, code sẽ bị sai thật. Vì theo tư duy đơn giản của em phải có cái gì đó so sánh theo giờ lớn bé min, max ở đây. Em cảm ơn Anh đã giúp đỡ ạ.
Bài đã được tự động gộp:

Hic. Tôi đọc code đó còn tẩu hỏa nhập ma nữa là.
Cảm ơn OT và Anh Maika. Đã F8 để đọc kết quả nhưng cũng vẫn khó hiểu. Dic với em thấy khó thật. Em cần nhiều thời gian để đọc và nghiền ngẫm thêm.
 
Upvote 0
Upvote 0
Mình giải thích theo cách hiểu của bản thân, bạn tham khảo:
Lần đầu tiên thấy comment code Dict đúng 99%. Cho 1 like.
Còn cái Dic trong Dic thì chưa chắc nhé.
Ghi chú: Comment của @Hoàng Nhật Phương đúng, có thể sử dụng. Thêm 1 chút (có thể nhiều chút nhưng tạm lấy 1):
Khai báo biến Long, Double, ... nói chung là biến dạng number, ngay khi khởi chạy code biến nhận giá trị 0, muốn giá trị khác phải gán vào.
Tương tự biến loại string khi khởi chạy code sẽ nhận giá trị chuỗi rỗng (""), biến loại object sẽ nhận giá trị nothing, biến không khai báo kiểu sẽ nhận giá trị empty
 
Upvote 0
Lần đầu tiên thấy comment code Dict đúng 99%. Cho 1 like.
Còn cái Dic trong Dic thì chưa chắc nhé.
Ghi chú: Comment của @Hoàng Nhật Phương đúng, có thể sử dụng. Thêm 1 chút (có thể nhiều chút nhưng tạm lấy 1):
Khai báo biến Long, Double, ... nói chung là biến dạng number, ngay khi khởi chạy code biến nhận giá trị 0, muốn giá trị khác phải gán vào.
Tương tự biến loại string khi khởi chạy code sẽ nhận giá trị chuỗi rỗng ("")
Oài , con chào chú Mỹ, được chú Mỹ khen chắc là phải có tiến bộ nhiều rồi.
Với con bài Dic trong Dic đó đúng là đã giúp con tiến bộ rất nhiều ạ.
 
Upvote 0
Đã F8 để đọc kết quả nhưng cũng vẫn khó hiểu. Dic với em thấy khó thật. Em cần nhiều thời gian để đọc và nghiền ngẫm thêm.
Bạn tự làm những cấu trúc đơn giản như tôi ví dụ (nhưng data phải nhiều cột hơn).
- Ban đầu thì bắt chước y chang code ví dụ.
- Sau đó thì làm với điều kiện ở 1 cột khác và cố nhớ cấu trúc cú pháp chứ không nhìn mẫu nữa. Quên đâu thì giở ra xem lại.
- Tiếp theo là cố không thèm xem lại code mẫu nữa.
- Sau đó thì thử làm với điều kiện là nhiều cột.
- .... Trình độ tôi mới tới đây hà. Có chăng là ứng biến có linh hoạt chút
 
Upvote 0
Bạn tự làm những cấu trúc đơn giản như tôi ví dụ (nhưng data phải nhiều cột hơn).
- Ban đầu thì bắt chước y chang code ví dụ.
- Sau đó thì làm với điều kiện ở 1 cột khác và cố nhớ cấu trúc cú pháp chứ không nhìn mẫu nữa. Quên đâu thì giở ra xem lại.
- Tiếp theo là cố không thèm xem lại code mẫu nữa.
- Sau đó thì thử làm với điều kiện là nhiều cột.
- .... Trình độ tôi mới tới đây hà. Có chăng là ứng biến có linh hoạt chút
Em cảm ơn anh nhiều. Em sẽ cố gắng !
 
Upvote 0
Oài , con chào chú Mỹ, được chú Mỹ khen chắc là phải có tiến bộ nhiều rồi.
Với con bài Dic trong Dic đó đúng là đã giúp con tiến bộ rất nhiều ạ.
Câu hỏi:
Căn cứ thực tế dữ liệu, trong code gốc khi đã tồn tại trong Dict, gán dữ liệu vào dòng b = a + 1 có nguy cơ sai hay không?
 
Upvote 0
Cách học của người đi làm và có tuổi sẽ khác với người trẻ bạn ạ. Học ngoại ngữ cũng thế thôi, người đi làm học ngoại ngữ cũng có cách học riêng để đốt nhanh giai đoạn ở đoạn nào đó. Mỗi người một cách học và nhu cầu tùy theo điều kiện và thời gian. . . . . . . .
Chỉ xin nhắn nhũ với bạn 1 điều xíu thôi: Là 1 ngôn ngữ, nên muốn học cũng nên dịch & chuyển sang tiếng mẹ đẽ để hiểu về nó;
Nếu không biết dịch sang tiếng Việt thì bạn lúc nào cũng coi như gặp câu lệnh mới mà thôi; không nhập tâm vô đầu được đâu.
Còn như muốn cưỡi ngựa xem hoa thì cách của bạn là OK!

Còn như muốn dich 1 mệnh đề lệnh VBA sang tiếng Việt ta nên dịch từ phải sang trái (là phần nhiều)
Ví dụ:
Set Rng = [B3:C7]
ta nên dịch là đem vùng ô từ B3 đến C7 gán vô tham biến (đã khai báo có tên là) Rng

Chúc mọi người khỏe nha!
 
Upvote 0
Câu hỏi:
Căn cứ thực tế dữ liệu, trong code gốc khi đã tồn tại trong Dict, gán dữ liệu vào dòng b = a + 1 có nguy cơ sai hay không?
Dạ , nếu dữ liệu đã sắp xếp theo ngày giờ và ID thì:
Mã:
b = dic.Item(dk) + 1
thay bằng:
Mã:
b = a + 1
Chắc là không sai ạ --=0
 
Upvote 0
Mong anh cho ý nghĩa của các dòng trong code và thuật toán của code với ạ.

Nhiều bạn đã tận tình hướng dẫn rồi nhé.
Tôi chỉ có một chú ý nữa là trong thực tế bảng chấm công sẽ có phát sinh trường hợp quên bấm vào và quên bấm ra --> Sai dữ liệu khi kết chuyển.
Và tôi cũng nhớ không lầm là khi truy xuất dữ liệu từ máy chấm công sẽ bao gồm luôn cột thông tin In/Out, khi đó sẽ có thêm dữ kiện để dễ xử lý hơn nhưng chắc chắn vẫn có sự can thiệp điều chỉnh thủ công.
 
Upvote 0
Nhiều bạn đã tận tình hướng dẫn rồi nhé.
Tôi chỉ có một chú ý nữa là trong thực tế bảng chấm công sẽ có phát sinh trường hợp quên bấm vào và quên bấm ra --> Sai dữ liệu khi kết chuyển.
Và tôi cũng nhớ không lầm là khi truy xuất dữ liệu từ máy chấm công sẽ bao gồm luôn cột thông tin In/Out, khi đó sẽ có thêm dữ kiện để dễ xử lý hơn nhưng chắc chắn vẫn có sự can thiệp điều chỉnh thủ công.
Dạ, em cảm ơn anh nhiều ạ !
 
Upvote 0
nếu dữ liệu đã sắp xếp theo ngày giờ và ID thì:
Sai rồi. Hai câu lệnh không như nhau vì a đã tăng 2 ở trên. Kết quả b = a + 1 sai.
Ngoài ra:
Do dữ liệu sắp thứ tự theo cột Time tăng dần, và quy ước dòng đầu tiên là giờ vào, và dòng cuối là giờ ra, đồng thời dữ liệu không có chuyện quên chấm công vào hoặc quên chấm công ra, nên code trên chạy đúng. Quy ước khác hoặc chấm công thiếu sẽ sai.
Còn 1 việc nữa:
Khi có nhiều dòng vào và nhiều dòng ra, trừ dòng lẻ của kết quả chỉ ghi 1 lần, tất cả dòng chẵn bị ghi nhiều lần và ghi đè lên cho tới dòng cuối, kể cả ghi dòng vào và dòng ra.
 
Upvote 0
Lý thuyết đọc ở đây mới đầy đủ và mạch lạc.


Điều quan trọng, phải theo lộ trình, ABC rồi mới XYZ được. Cụ thể, phải thành thạo phần Array rồi mới dùng tới thư viện. Tức là dùng Array tới mức mà phát hiện, mà cảm thấy thiếu thiếu cái gì đó thì lúc đó dùng tới các thư viện rất dễ dàng.

1628954811660.png
 
Upvote 0
@Chủ bài đăng: Theo mình để tìm ra giải thuật thích hợp cho 1 bài toán ta phải đi từ thiết kế CSDL của nó; Ở đây là bảng dữ liệu như mình trích dười đây:

DateID NumberNameTimeTạmSTT
7/1/2019​
NVA00NGUYEN VAN AN
9:40:00​
Giờ vào1
7/1/2019​
NVA00NGUYEN VAN AN
10:00:19​
2
7/1/2019​
NVA00NGUYEN VAN AN
13:47:59​
3
7/1/2019​
NVA00NGUYEN VAN AN
14:26:08​
4
7/1/2019​
NVA00NGUYEN VAN AN
15:10:52​
5
7/1/2019​
NVA00NGUYEN VAN AN
16:03:59​
Giờ ra6
7/2/2019
NVA00NGUYEN VAN AN
9:05:23​
Giờ vào7
7/2/2019
NVA00NGUYEN VAN AN
9:48:52​
8
7/2/2019
NVA00NGUYEN VAN AN
10:33:44​
9
7/2/2019
NVA00NGUYEN VAN AN
11:46:31​
10
7/2/2019
NVA00NGUYEN VAN AN
13:40:29​
11
7/2/2019
NVA00NGUYEN VAN AN
14:25:15​
12
7/2/2019
NVA00NGUYEN VAN AN
15:53:47​
13
7/2/2019
NVA00NGUYEN VAN AN
16:59:37​
Giờ ra14
7/3/2019​
NVA00NGUYEN VAN AN
11:43:01​
Giờ vào15
7/3/2019​
NVA00NGUYEN VAN AN
12:58:25​
Giờ ra16
7/1/2019​
TDH00TRAN THI DIEU HUYEN
9:16:16​
Giờ vào17
7/1/2019​
TDH00TRAN THI DIEU HUYEN
12:34:03​
18
7/1/2019​
TDH00TRAN THI DIEU HUYEN
18:26:24​
Giờ ra19
7/2/2019​
TDH00TRAN THI DIEU HUYEN
10:52:59​
Giờ vào20
7/2/2019​
TDH00TRAN THI DIEU HUYEN
12:06:44​
21
7/2/2019​
TDH00TRAN THI DIEU HUYEN
12:37:58​
22
7/2/2019​
TDH00TRAN THI DIEU HUYEN
18:20:21​
Giờ ra23

Có nghĩa là Trong 1 ngày với 1 người giờ đầu tiên sẽ là mốc vô cơ quan (CQ); còn giờ cuối (trong ngày) là giờ ra (về)
Với phân tích đầu tiên như vậy, ta có thể hoàn toàn dùng vòng lặp để xử công việc này; Tuy nhiên tốc độ sẽ rùa bò nhất, nhưng ít cần chất xám VBA nhất; Có nghĩa là chỉ cần trình sơ cấp (bằng A VBA) là xử được (Cần 3-6 tháng để sở hữu tấm bằng này)

Người có trình bằng B thì đưa dữ liệu vô mảng để xử, tốc độ có thể tăng lên ~ mươi lần (Mình chưa đo thử nên đó là số áng chừng tiện cho bạn so sánh hay đối chiếu) (Cần thêm từng í tháng nữađể có bằng B)

Người có trình bằng C thì áp dụng Dictionary; tốc độ có thể cải thiện thêm 20 - 30%. & thời gian cần tiêu tốn cỡ đó thêm nữa để sở hữu tấm bằng quí báu này
Tuy có trình C nhưng nếu ta thiếu phân tích đề bài thì giống như mặc véc với quần đùi đi dạo phố vậy.

Mong mọi người vui vẻ & sức khỏe vượt qua đợt dịch quáy ác này!
 
Upvote 0
Hic, đúng là con sai vì cái tính nhanh ẩu không thử, nếu dữ liệu như thực tế thì : b = a - 1 mới phải.
Câu hỏi tiếp theo:
Bài #30 ghi rằng: Khi có nhiều dòng vào và nhiều dòng ra, trừ dòng lẻ của kết quả chỉ ghi 1 lần, tất cả dòng chẵn bị ghi nhiều lần và ghi đè lên cho tới dòng cuối (giá trị đúng), kể cả ghi dòng vào và dòng ra.
Hỏi làm cách nào để các dòng chẵn chỉ ghi 1 lần giá trị đúng nhất?
 
Upvote 0
Câu hỏi tiếp theo:
Bài #30 ghi rằng: Khi có nhiều dòng vào và nhiều dòng ra, trừ dòng lẻ của kết quả chỉ ghi 1 lần, tất cả dòng chẵn bị ghi nhiều lần và ghi đè lên cho tới dòng cuối (giá trị đúng), kể cả ghi dòng vào và dòng ra.
Hỏi làm cách nào để các dòng chẵn chỉ ghi 1 lần giá trị đúng nhất?
Hic chú Mỹ hỏi thế này con hơi khó hiểu, nếu có dữ liệu gì đó con còn dễ hình dung,nhưng mà chú Mỹ toàn hỏi khó chắc với khả năng hiện giờ con chịu thua.
Bài đã được tự động gộp:

Xin chào tất cả mọi người,
Tôi có một đoạn code dưới đây,có nhiều đoạn có vẻ giống nhau và phải chạy 2 vòng For r. Vậy có thể rút gọn lại và chỉ sử dụng một vòng lặp For r được không ạ?

Mã:
Option Explicit

Sub D_I_C()

    '//Khai bao bien(tham so)
    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
    
    '//Khoi tao DIC
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")

    '// thuc hien tren sheet co ten la DATA cua chinh file chay code nay
    With ThisWorkbook.Worksheets("DATA")
    
        '// xac dinh dong cuoi trong bang du lieu tu cot C:I, lay dong cuoi trong cot C
        r = .Cells(.Rows.Count, "C").End(xlUp).Row

        '// neu dong cuoi < 4 khong co du lieu, thoat thu tuc
        If r < 4 Then
            '// Thong bao khong tim thay du lieu
            MsgBox "Khong tim thay du lieu dau vao", vbCritical + vbOKOnly, "Kiem tra lai"
            '/Thoat thu tuc
            Exit Sub
        End If
        
        '// Gan du lieu vao mang data
        data = .Range("C4:I" & r).Value
        
        '//khai bao kich thuoc cho cac mang ket qua voi chieu thu nhat = mang data, chieu thu 2 = 3 cot
        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)
        
        '// duyet vong lap trong mang data bat dau tu can duoi (LBound) den can tren (UBound) so do du lieu
        '//VONGLAP 1: Dua ngay/ma/ten vao DIC
        For r = LBound(data, 1) To UBound(data, 1)
            '//Ghep ngay/ma/ten tao thanh Key(dieu kien)
            sKey = data(r, 1) & "|" & data(r, 3) & "|" & data(r, 4)
            '//Dua ngay/ma/ten vao DIC
            If Not dic.Exists(sKey) Then dic.Add sKey, r
        Next r
        
        '//Lap lai vong lap tren
        '//VONGLAP 2: Kiem tra su LOGIC
        For r = LBound(data, 1) To UBound(data, 1)
            '// Xac dinh key voi ngay "1/1/2020"/Ma/Ten
            sNgayTruoc = .Range("K3") & "|" & data(r, 3) & "|" & data(r, 4)
            
            '// Xac dinh key voi ngay "1/30/2020"/Ma/Ten
            sNgaySau = .Range("O3") & "|" & data(r, 3) & "|" & data(r, 4)
              
            '// Neu Key cho ngay "1/1/2020" da ton tai thi lay
            If dic.Exists(sNgayTruoc) Then
                '// Neu Key cho ngay "1/30/2020" khong ton tai hoac khong lay key (ma/Ten) cua ngay sau.
                If Not dic.Exists(sNgaySau) Then
                    '//Tao key tam them "#Res1#" de phan biet su khac nhau voi các KEY gan vao tai vong lap 1
                    sKey = "#Res1#" & sNgayTruoc
                    
                    '// neu chua ton tai Key
                    If Not dic.Exists(sKey) Then
                        k1 = k1 + 1 '// Moi lan xuat hien Key moi se tang len 1
                        dic.Add sKey, k1 'Gan Key vao DiC & ghi nho thu tu (chi dong) cua mang Res1
                        res1(k1, 1) = data(r, 3) '//Ma
                        res1(k1, 2) = data(r, 4) '//Ten
                        res1(k1, 3) = data(r, 7) '//Gia tri
                    Else '// Neu key moi tai
                        iK = dic.Item(sKey) '//lay ra(xac dinh) so dong (thu tu) da ghi nho K1 o tren
                        res1(iK, 3) = res1(iK, 3) + data(r, 7) '// Cong don vao dong thu tu tim duoc trong mang resr1
                    End If
                End If
            End If
            
             '// Neu Key cho ngay "1/1/2020" khong ton tai hoac co ton tai thi bo qua
            If Not dic.Exists(sNgayTruoc) Then
                '// Neu Key cho ngay  "1/30/2020" da ton tai thi lay
                If dic.Exists(sNgaySau) Then
                    '//Tao key tam them "#Res2#" de phan biet su khac nhau voi các KEY gan vao tai vong lap 1 va vong lap gan key cho Res1 ? tren
                    sKey = "#Res2#" & sNgayTruoc
                    If Not dic.Exists(sKey) Then '//Tuong tu o tren
                        k2 = k2 + 1
                        dic.Add sKey, k2
                        res2(k2, 1) = data(r, 3)
                        res2(k2, 2) = data(r, 4)
                        res2(k2, 3) = data(r, 7)
                    Else
                        iK = dic.Item(sKey)
                        res2(iK, 3) = res2(iK, 3) + data(r, 7)
                    End If
                End If
            End If
            
            If dic.Exists(sNgayTruoc) Then '// Neu Key cho ngay "1/1/2020" ton tai
                If dic.Exists(sNgaySau) Then '// Neu Key cho ngay "1/30/2020"
                    '//Tao key tam them "#Res3#"  de phan biet su khac nhau voi cac key da gan vao DIC
                    sKey = "#Res3#" & sNgayTruoc
                    If Not dic.Exists(sKey) Then '//Tuong tu o tren
                        k3 = k3 + 1
                        dic.Add sKey, k3
                        res3(k3, 1) = data(r, 3)
                        res3(k3, 2) = data(r, 4)
                        res3(k3, 3) = data(r, 7)
                    Else
                        iK = dic.Item(sKey)
                        res3(iK, 3) = res3(iK, 3) + data(r, 7)
                    End If
                End If
            End If
        Next r
        
        '//Tu K5 quet xuong duoi 1000 dong va quet sang phai 11 cot roi xoa du lieu cu
        .Range("K5").Resize(1000, 11).ClearContents
        
        '//Gan ket qua tung mang xuong tung vung tren bang tinh
        If k1 > 0 Then .Range("K5").Resize(k1, 3).Value = res1 '// ket qua ngay truoc
        If k2 > 0 Then .Range("O5").Resize(k2, 3).Value = res2 '// ket qua ngay sau
        If k3 > 0 Then .Range("S5").Resize(k3, 3).Value = res3 '// ket qua chung
        
    End With
    
    '// Giai phong (xoa dic) DIC
    Set dic = Nothing
    
    '// Thong bao da xu ly xong
    MsgBox "OK, xong", vbInformation + vbOKOnly, "Ket thuc."
    
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hic chú Mỹ hỏi thế này con hơi khó hiểu, nếu có dữ liệu gì đó con còn dễ hình dung,nhưng mà chú Mỹ toàn hỏi khó chắc với khả năng hiện giờ con chịu thua
Mã:
             '// duyet vong lap trong mang data bat dau tu can duoi (LBound) den can tren (UBound) so do du lieu
Tại không nhìn thấy việc ghi đè dòng chẵn. Dùng debug.Print lấy giá trị kết quả dòng 2 sẽ thấy bị ghi nhiều lần, cho đến hết 1 nhân viên.
Cho i chạy từ 1 đến 6 là hết ngày 01/07 của NGUYEN VAN AN, Dòng 1 ghi kết quả 1 lần, dòng 2 ghi kết quả 5 lần mặc dù chỉ lần thứ 5 là kết quả đúng.

1629071935816.png

2. LBound không phải cận dưới, UBound không phải cận trên. Cận là gần và cận trên cận dưới nói về phần tử gần nhất có chỉ số lớn hơn và phần tử gần nhất có chỉ số nhỏ hơn của 1 giá trị. Ví dụ có mảng {1, 2, 3, 4, 5, 6, 7} và giá trị 3.5; cận dưới của 3.5 là 4 và cận trên của 3.5 là 3.
Nếu mảng {7, 6, 5, 4, 3, 2, 1} thì cận dưới của 3.5 là 3 và cận trên là 4.
LBound là chỉ số nhỏ nhất và UBound là chỉ số lớn nhất của 1 mảng (chỉ số = index)
 
Upvote 0
Tôi có một đoạn code dưới đây,có nhiều đoạn có vẻ giống nhau và phải chạy 2 vòng For r. Vậy có thể rút gọn lại và chỉ sử dụng một vòng lặp For r được không ạ?
Bỏ for và next của vòng lặp 2, cho nguyên xi code của vòng lặp 2 vào Else của if r <4
 
Upvote 0
Bỏ for và next của vòng lặp 2, cho nguyên xi code của vòng lặp 2 vào Else của if r <4
Cái này cụ thể là sao vậy chú Mỹ, của code trên của con làm gì có else của if r<4 ạ?
Con bổ sung yêu cầu của bài 35 (đây là bài toàn con code giùm một bạn):
+ Tại ngày 01.01 thì code chỉ cần lấy Y và X vì nó không có ở ngày 30/01. Còn 3 mã A, B,C trùng của 2 ngày thì không lấy.
+ Tại ngày 30.01 thì code chỉ cần lấy K và L vì nó không có ở ngày 01/01. Còn 3 mã A, B,C trùng của 2 ngày thì không lấy.
+ Chung: Chỉ cần lấy A, B,C vì nó chung của 2 ngày. Còn cái riêng của hai cái này thì không lấy.
 
Lần chỉnh sửa cuối:
Upvote 0
Cái này cụ thể là sao vậy chú Mỹ, của code trên của con làm gì có else của if r<4 ạ?
Con bổ sung yêu cầu của bài 35 (đây là bài toàn con code giùm một bạn):
Có if r < 4. Code của mình mà cũng không đọc kỹ. Chưa có Else thì tạo else

1629078287155.png

Ngoài ra theo tiêu đề của bảng 3 "CHENH LECH (NGÀY 30 TRỪ ĐI NGÀY 01)" thì code đang sai. Kết quả như các ô chữ đỏ mới đúng

1629078495648.png
 
Upvote 0
Có if r < 4. Code của mình mà cũng không đọc kỹ. Chưa có Else thì tạo else

View attachment 264174

Ngoài ra theo tiêu đề của bảng 3 "CHENH LECH (NGÀY 30 TRỪ ĐI NGÀY 01)" thì code đang sai. Kết quả như các ô chữ đỏ mới đúng

View attachment 264175
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...
--------
Về kết quả chênh lệch , nếu "kết quả như các ô chữ đỏ mới đúng" thì code lại dài thêm 1 đoạn:

Mã:
                    ''...
                    If Not dic.Exists(sKey) Then '//Tuong tu o tren
                        k3 = k3 + 1
                        dic.Add sKey, k3
                        res3(k3, 1) = data(r, 3)
                        res3(k3, 2) = data(r, 4)
                        If data(r, 1) = .Range("K3") Then
                            res3(k3, 3) = data(r, 7) * -1
                        ElseIf data(r, 1) = .Range("O3") Then
                            res3(k3, 3) = data(r, 7)
                        End If
                    Else
                        iK = dic.Item(sKey)
                        If data(r, 1) = .Range("K3") Then
                            res3(iK, 3) = res3(iK, 3) - data(r, 7)
                        ElseIf data(r, 1) = .Range("O3") Then
                            res3(iK, 3) = res3(iK, 3) + data(r, 7)
                        End If
                    End If
                    ''...
 
Lần chỉnh sửa cuối:
Upvote 0
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.
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
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
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
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
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
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
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
- 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:
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
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
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ài viết mới nhất

Back
Top Bottom