Xin hỏi về cách sử dụng Dictionary

[HieuCD]

Cám ơn bạn HieuCD.
Đã sửa lại code thì điều kiện không đúng khiến key của Dic bị trùng lặp.

  Dic.RemoveAll
  With Sheets("Order_list").Range("C9:D370")
    sArr = .Value
    For i = 1 To UBound(sArr)
        iKey3 = sArr(i, 2)
        If cViec = sArr(i, 1) And Dic.exists(iKey3) = False Then
            Dic.Add iKey3, ""
        End If
    Next i
  End With

  With Sheets("Memberlist").Range("D6").Validation
    .Delete
    .Add xlValidateList, , , Join(Dic.keys, ",")
  End With

Tuy nhiên lại bị lỗi tiếp theo ở dòng này.
Lỗi thông báo Application Define or Object Define Error.

.Add xlValidateList, , , Join(Dic.keys, ",")

Không biết vì sao bị lỗi nữa

.Add 3, , , Join(Dic.keys, ",")

 

[thaitungchi]

.Add 3, , , Join(Dic.keys, ",")

Vẫn bị lỗi như thường bạn à.

 

[HieuCD]

Vẫn bị lỗi như thường bạn à.

Sai biến điều kiện

Sub Sample()
  Set Dic = CreateObject("Scripting.Dictionary")
  DuAn = Sheets("Memberlist").Range("D4")
  Dic.RemoveAll
  With Sheets("Order_list").Range("C9:D370")
    sArr = .Value
    For i = 1 To UBound(sArr)
        iKey3 = sArr(i, 2)
        If DuAn = sArr(i, 1) And Dic.exists(iKey3) = False Then
            Dic.Add iKey3, ""
        End If
    Next i
  End With

  With Sheets("Memberlist").Range("D6").Validation
    .Delete
    If Dic.Count > 0 Then .Add 3, , , Join(Dic.Keys, ",")
  End With
End Sub

 

[thaitungchi]

Không hiểu sao vẫn còn bị lỗi bạn à. Ở phần lệnh này.

.Add 3, , , Join(Dic.Keys, ",")

 

[thaitungchi]

Được rồi bạn HieuCD à. Lúc đầu bị lỗi nhưng lúc sau không còn nữa. Cám ơn bạn nhiều nhiều.

 

[thaitungchi]

Bạn HieuCD cho hỏi một phần nữa là mình cũng sử dụng dòng lệnh dưới đây của bạn nhưng mà loại công việc của những dự án tương tự không được cộng thêm vào trong list. Có vẻ như dòng lệnh dưới không hoạt động đúng.

If sArr(i, 1) Like DuAn & "*" And Dic.exists(iKey3) = False Then

 

[befaint]

Bạn HieuCD cho hỏi một phần nữa là mình cũng sử dụng dòng lệnh dưới đây của bạn nhưng mà loại công việc của những dự án tương tự không được cộng thêm vào trong list. Có vẻ như dòng lệnh dưới không hoạt động đúng.

If sArr(i, 1) Like DuAn & "*" And Dic.exists(iKey3) = False Then

Liệt kê chục dòng không được lên xem nào.

 

[HieuCD]

Bạn HieuCD cho hỏi một phần nữa là mình cũng sử dụng dòng lệnh dưới đây của bạn nhưng mà loại công việc của những dự án tương tự không được cộng thêm vào trong list. Có vẻ như dòng lệnh dưới không hoạt động đúng.

If sArr(i, 1) Like DuAn & "*" And Dic.exists(iKey3) = False Then

Tùy theo dữ liệu có cách xử lý khác nhau, chỉ 1 lệnh không thể biết vấn dề ở đâu

 

[congnguyen88]

Xin các bác cho hỏi có cách nào điền giá trị lưu trong mydict (Dictionary) ra một cell nào đó, ví dụ A1:A.

Mặc dù đã có tham khảo cách sử dụng Dictionary trên diễn đàn rồi nhưng mà chưa có hướng dẫn chi tiết, hoặc là khả năng VBA còn hạn chế quá.



Mong các cao thủ ra tay cứu giúp.

Sub Sample4()

   Dim mydict As Object

   Set mydict = CreateObject("Scripting.Dictionary")



   Dim c As Range

   Dim firstAddress As String

   Dim dk1 As Variant

   Dim dk2 As Variant



   dk1 = Worksheets("Memberlist").Range("D4").Value

   dk2 = Worksheets("Memberlist").Range("D6").Value



   With Worksheets("OrderList").Range("C9:C370")

       Set c = .Find(dk1, LookIn:=xlValues, LookAt:=xlPart)

           If Not c Is Nothing Then

               firstAddress = c.Address

               If dk2 = "" Then

                   MsgBox ("Please Input Worktype")

               Else

                   Do

                       If dk2 = c.Offset(0, 1).Value Then

                           mydict.Add c.Offset(0, -2).Value, ""

                           MsgBox ("Gia tri la" & c.Offset(0, -2).Value)

                       End If

                       Set c = .FindNext(c)

                       If c Is Nothing Then Exit Do        Post thread

                   Loop Until c.Address = firstAddress

               End If

           End If

   End With





End Sub

Code khá phức tạp mình viết gần 30 phút

Sub abc()
  Dim sArr(), Res(), shName, Dic As Object, iKey$, iKey2$
  Dim eRow&, eCol&, i&, n&, ik&, j&
  Dim DuAn$, cViec$
  Const sNV As Long = 70 + 30
 
  shName = Array("4-9", "10-3")
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Memberlist")
    .Range("B12:C1000").ClearContents
    DuAn = .Range("D4").Value
    cViec = .Range("D6").Value
    If DuAn = Empty Or cViec = Empty Then Exit Sub
  End With
  With Sheets("Order_List")
    sArr = .Range("A9:D370").Value
    For i = 1 To UBound(sArr)
      If sArr(i, 3) = DuAn And sArr(i, 4) = cViec Then
        iKey = sArr(i, 1)
        Dic.Item(iKey) = k
        k = k + sNV
      End If
    Next i
  End With
  ReDim Res(1 To k, 1 To 2)
  For n = 0 To UBound(shName)
    With Sheets(shName(n))
      eRow = .Range("C" & Rows.Count).End(xlUp).Row
      eCol = .Cells(4, 16000).End(xlToLeft).Column
      sArr = .Range("B5", .Cells(eRow, eCol)).Value
      For i = 1 To UBound(sArr)
        For j = 6 To UBound(sArr, 2)
          iKey = sArr(i, j)
          If Dic.exists(iKey) Then
            iKey2 = sArr(i, 1) & "#" & iKey
            If Dic.exists(iKey2) = False Then
              Dic.Add iKey2, ""
              ik = Dic.Item(iKey) + 1
              Dic.Item(iKey) = ik
              Res(ik, 1) = iKey
              Res(ik, 2) = sArr(i, 2)
            End If
          End If
        Next j
      Next i
    End With
  Next n
  k = 0
  For i = 1 To UBound(Res)
    If Res(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = Res(i, 1 + 1 - 1)
      Res(k, 2) = Res(i, 2 + 1 - 1)
    End If
  Next i
  If k Then Sheets("Memberlist").Range("B12").Resize(k, 2 + 1 - 1) = Res
End Sub

Bài đã được tự động gộp: 29/3/20

Xin các bác cho hỏi có cách nào điền giá trị lưu trong mydict (Dictionary) ra một cell nào đó, ví dụ A1:A.

Mặc dù đã có tham khảo cách sử dụng Dictionary trên diễn đàn rồi nhưng mà chưa có hướng dẫn chi tiết, hoặc là khả năng VBA còn hạn chế quá.



Mong các cao thủ ra tay cứu giúp.

Sub Sample4()

   Dim mydict As Object

   Set mydict = CreateObject("Scripting.Dictionary")



   Dim c As Range

   Dim firstAddress As String

   Dim dk1 As Variant

   Dim dk2 As Variant



   dk1 = Worksheets("Memberlist").Range("D4").Value

   dk2 = Worksheets("Memberlist").Range("D6").Value



   With Worksheets("OrderList").Range("C9:C370")

       Set c = .Find(dk1, LookIn:=xlValues, LookAt:=xlPart)

           If Not c Is Nothing Then

               firstAddress = c.Address

               If dk2 = "" Then

                   MsgBox ("Please Input Worktype")

               Else

                   Do

                       If dk2 = c.Offset(0, 1).Value Then

                           mydict.Add c.Offset(0, -2).Value, ""

                           MsgBox ("Gia tri la" & c.Offset(0, -2).Value)

                       End If

                       Set c = .FindNext(c)

                       If c Is Nothing Then Exit Do        Post thread

                   Loop Until c.Address = firstAddress

               End If

           End If

   End With





End Sub

Dictionary (gọi tắt là Dic dưới đây) là bảng tra theo quy luật key-item. Tức là phép chiếu từng phần tử tập hợp A sang tập hợp B.

Công dụng chính của Dic là bảng tra.
Vì Dic dùng kỹ thuật tra key (hầu hết các thết kế dùng bảng băm) rất hiệu quả cho nên lập bảng tra bằng Dic giúp cải tiến tốc độ chương trình. Lưu ý là phải tra nhiều lần mới tính chuyện hiệu quả; chứ tra có một lần mà bảo phải lập nguyên cái Dic để tra thì là làm chuyện thừa thải.
Và vì luật key-item bắt buộc các phần tử key phải là duy nhất cho nên dân lập trình cũng lợi dụng tính chất này để "lọc duy nhất"

Trước khi tiếp tục với đề bài của bạn thì bạn cho biết vì sao bạn chọn Dic để thực hiện giải thuật của mình.
Chứ đọc cái trọng tâm đề bài "nhập tên dự án, và ... thì sẽ hiện ra..." tôi chưa thấy nó liên quan đến Dic.

 

[congnguyen88]

trong bất bộ Office nào cũng có 1 mớ sách hay ... nếu thật sự đam mê nó thì sẻ lục hết nó ra có nhiều thứ rất hay và hơn thế nữa
View attachment 234100

Xin lỗi mọi người vì giải thích thiếu sót nhiều quá. Giải thích chi tiết như sau:

Đây là file quản lý danh sách đơn hàng. Như mọi người nhìn thấy trong sheet “Order List”, có một loạt đơn hàng có mã số (1738, 1739, 1740, 1885, v.v...)

Các đơn hàng sẽ có tên mã dự án (projectA, B...), loại công việc (worktype), thời gian bắt đầu, thời gian kết thúc, số ngày công. Các thông tin này sẽ lấy từ sheet “4-9” và sheet “10-3”.

Trong sheet “4-9” và sheet “10-3” này cấu trúc là chiều ngang là ngày tháng và chiều dọc là danh sách thành viên (tên nhân viên, mã số nhân viên). Ví dụ sheet “4-9” thì sẽ chiều ngang từ ngày 1/4 đến 30/9, sheet “10-3” sẽ là từ 1/10 đến 31/3. Hai sheet này sẽ chứa thông tin, thành viên nào tham gia vào đơn hàng nào, từ ngày nào đến ngày nào. Tại mỗi một ô trong bảng này, có ghi mã số đơn hàng tức là thành viên đấy, vào ngày đấy đã có tham gia vào đơn hàng đấy.

Ví dụ: Thành viên TKF0004, có mã số 304095 tham gia vào đơn hàng 1738 từ 1/4 đến 30/5. Có ba thành viên khác nữa là TKF00021, TKF00027, TKF00029 cũng tham gia vào đơn hàng 1738 từ ngày 1/4 đến 6/5.

Đề bài ở đây là: tại sheet “memberlist”, khi nhập tên dự án (khác với mã số đơn hàng) và loại công việc (worktype) thì sẽ liệt kê ra danh sách các đơn hàng có cùng tên dự án và loại công việc.

Ngoài ra, trong dự án này có bao nhiêu thành viên cũng liệt kê ra hết. Tại vì có những thành viên tên giống nhau nên khi lọc ra tên thành viên nên tìm theo mã số nhân viên.

Ví dụ: khi nhập tên dự án “ProjectA”, loại công việc 212H, dựa vào sheet “Oderlist” sẽ biết được ba đơn hàng đáp ứng được thông tin trên 1738, 1778, 1885.

Sau đó dựa vào 3 mã số đơn hàng, tại sheet “4-9” và sheet “10-3” tìm tất cả thành viên tham gia vào đơn hàng này và liệt kê ra từ ô B12

Đơn hàng 1738 thì có 4 thành viên, 1778 có 6 thành viên, và 1885 có 9 thành viên (TKF0020 bị trùng nhau giữa hai sheet). Những thành viên này cũng được liệt kê hết ra là thoã mãn yêu cầu đề bài.

Giải thích khá dài dòng mong mọi người thông cảm.

Nếu có điều gì chưa rõ ràng, mọi người cứ hỏi thêm.
Cám ơn mọi người dành thời gian quan tâm.

P/S: Xong đợt này quyết tâm mua sách VBA về học thêm mảng và dictionary. Chắc là giải pháp excel có những sách nào hướng dẫn chi tiêt và cụ thể về vấn đề này nhỉ.

 

[thaitungchi]

Cả khối lệnh ở đây bạn à. Mình chỉ sử dụng một phần code của bạn vào đây.

Set Dic = CreateObject("Scripting.Dictionary")
 
  With Sheets("Memberlist")
    .Range("B12:D1000").ClearContents
    DuAn = .Range("D4")
    cViec = .Range("D6").Value
    If DuAn = Empty Then Exit Sub
  End With
 
  Dic.RemoveAll
  With Sheets("Order_list").Range("C9:D370")
    sArr = .Value
    For i = 1 To UBound(sArr)
        iKey3 = sArr(i, 2)
        If sArr(i, 1) Like DuAn & "*" And Dic.exists(iKey3) = False Then
            Dic.Add iKey3, ""
        End If
    Next i
  End With
  With Sheets("Memberlist").Range("D6").Validation
    .Delete
    If Dic.Count > 0 Then .Add xlValidateList, , , Join(Dic.Keys, ",")
  End With

 

[HieuCD]

Cả khối lệnh ở đây bạn à. Mình chỉ sử dụng một phần code của bạn vào đây.

Set Dic = CreateObject("Scripting.Dictionary")

  With Sheets("Memberlist")
    .Range("B12:D1000").ClearContents
    DuAn = .Range("D4")
    cViec = .Range("D6").Value
    If DuAn = Empty Then Exit Sub
  End With

  Dic.RemoveAll
  With Sheets("Order_list").Range("C9:D370")
    sArr = .Value
    For i = 1 To UBound(sArr)
        iKey3 = sArr(i, 2)
        If sArr(i, 1) Like DuAn & "*" And Dic.exists(iKey3) = False Then
            Dic.Add iKey3, ""
        End If
    Next i
  End With
  With Sheets("Memberlist").Range("D6").Validation
    .Delete
    If Dic.Count > 0 Then .Add xlValidateList, , , Join(Dic.Keys, ",")
  End With

Có thể do chữ in và chữ thường, đầu module thêm dòng lệnh
Option Compare Text
Nếu chưa được thì nói rỏ ô D4 bạn gỏ gì mà không tạo được data validation

 

[thaitungchi]

Xin lỗi vì đã không trả lời được ngay.
Đúng như bạn HieuCD nói, do trong ô D4 nhập tên dự án có khoảng trống ở sau cùng nên không hiển thị đúng.

Các vấn đề đã được giải quyết hết nên xin phép dừng chủ đề ở đây. Cám ơn mọi người đã theo dõi và hỗ trợ rất nhiều.

Có thể do chữ in và chữ thường, đầu module thêm dòng lệnh
Option Compare Text
Nếu chưa được thì nói rỏ ô D4 bạn gỏ gì mà không tạo được data validation

 

[VetMini]

Thớt đã xác định thoả mãn rồi và muốn dừng cho nên lời này tôi không nói với thớt mà nói với các bạn khác đang đọc:

Có thể do chữ in và chữ thường, đầu module thêm dòng lệnh
Option Compare Text
Nếu chưa được thì nói rỏ ô D4 bạn gỏ gì mà không tạo được data validation

Option chỉ hiệu lực với code thường.
Mọi Options của Dic phải dựng bên trong nó. Nếu có lệnh Option trên đầu module thì cúng nên thêm dòng lệnh Opion cho Dic ngayt sau create nó.
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare (hay vb gì đó tuỳ thích)

Có 2 lưu ý:
1. một khi Dic đã có dữ liệu rồi thì nó không cho thay đổi cách compare nữa. Cẩn thận chỗ này. Nhất là ác code có "On Error Resume Next", khả năng ra dữ liệu sai mà không hay.
2. vbTextCompare là dùng cho Dic kết nối trễ. Các Dic kết nối sớm (lúc Dim nó) thì có các trị riêng của nó, không dùng vb (TexCompare,...)

Chú thêm: phần 2 của bài #29 là tác giả cắt xén một bài của tôi ở thớt khác. Tuy tác giả không đủ sỉ diện để báo nguồn gốc, nhưng những người quen sẽ nhận ra là lời của tôi. Vì vậy sẵn dịp này tôi tuyên bố khong chịu trách nhiệm với những lời cắt xén ấy. Ai đọc muốn hiểu gì thì hiểu.