Tạo list cho combobox (1 người xem)

[USB1394]

Mình có 7 chuỗi giá trị muốn tạo list cho combobox theo yêu cầu : Nếu chuỗi 1 <> rỗng và Chuỗi chưa có trong List của combobox thì AddItem nó vào , ngược lại thì xét tiếp chuỗi tiếp theo . Mình có đính kèm file mong các bạn chỉ dẫn giúp , xin cám ơn

 

[mhung12005]

Mình có 7 chuỗi giá trị muốn tạo list cho combobox theo yêu cầu : Nếu chuỗi 1 <> rỗng và Chuỗi chưa có trong List của combobox thì AddItem nó vào , ngược lại thì xét tiếp chuỗi tiếp theo . Mình có đính kèm file mong các bạn chỉ dẫn giúp , xin cám ơn

Xin hỏi thêm bạn: Nếu 3 chuỗi của bạn là {"A","A","B"} thì kết quả nó ra sao ?

 

[USB1394]

Xin hỏi thêm bạn: Nếu 3 chuỗi của bạn là {"A","A","B"} thì kết quả nó ra sao ?

Trong trường hợp trên thì dữ liệu thêm vào list bị trùng (đã có trước) thì bỏ qua ,và xét tiếp chuỗi kế tiếp

 

[Quang_Hải]

Mình có 7 chuỗi giá trị muốn tạo list cho combobox theo yêu cầu : Nếu chuỗi 1 <> rỗng và Chuỗi chưa có trong List của combobox thì AddItem nó vào , ngược lại thì xét tiếp chuỗi tiếp theo . Mình có đính kèm file mong các bạn chỉ dẫn giúp , xin cám ơn

Thử thế này. Chú ý là phải vẽ cái Combobox1 trên sheet trước khi chạy code. Phải chạy sub AutoOpen trước khi chạy code napCB

Option Explicit
Public Dic As Object
Sub napCB()
Dim Arr(), Item
Arr = Array([C3].Value, [C4].Value, [C5].Value)
ReDim Preserve Arr(6)
Arr(3) = Arr(0) & Arr(1)
Arr(4) = Arr(0) & Arr(2)
Arr(5) = Arr(1) & Arr(2)
Arr(6) = Arr(0) & Arr(1) & Arr(2)
For Each Item In Arr
   If Item <> "" Then
      If Not Dic.exists(Item) Then
         Dic.Add Item, ""
      End If
   End If
Next
ActiveSheet.ComboBox1.List = Dic.keys
End Sub
Sub Auto_Open()
Set Dic = CreateObject("scripting.dictionary")
End Sub

 

[USB1394]

Thử thế này. Chú ý là phải vẽ cái Combobox1 trên sheet trước khi chạy code. Phải chạy sub AutoOpen trước khi chạy code napCB

Option Explicit
Public Dic As Object
Sub napCB()
Dim Arr(), Item
Arr = Array([C3].Value, [C4].Value, [C5].Value)
ReDim Preserve Arr(6)
Arr(3) = Arr(0) & Arr(1)
Arr(4) = Arr(0) & Arr(2)
Arr(5) = Arr(1) & Arr(2)
Arr(6) = Arr(0) & Arr(1) & Arr(2)
For Each Item In Arr
   If Item <> "" Then
      If Not Dic.exists(Item) Then
         Dic.Add Item, ""
      End If
   End If
Next
ActiveSheet.ComboBox1.List = Dic.keys
End Sub
Sub Auto_Open()
Set Dic = CreateObject("scripting.dictionary")
End Sub

Xin cảm ơn Bạn đã giúp đỡ ,cũng mai là mình vừa đọc xong đề tài scripting.dictionary nên cũng hiểu code trên , Bạn có giải pháp nào mà không đụng đến CreateObject("scripting.dictionary") không ?

 

[Quang_Hải]

Xin cảm ơn Bạn đã giúp đỡ ,cũng mai là mình vừa đọc xong đề tài scripting.dictionary nên cũng hiểu code trên , Bạn có giải pháp nào mà không đụng đến CreateObject("scripting.dictionary") không ?

Cách thì luôn luôn có, nhưng cái gọn nhẹ nhanh chính xác tại sao không xài? Nếu không dùng Dic thì code dài ra 10 lần thì bạn có chọn nó không? Mình không chơi đâu. Không dại gì đụng đầu vô trụ đèn.

 

[Let'GâuGâu]

Xin cảm ơn Bạn đã giúp đỡ ,cũng mai là mình vừa đọc xong đề tài scripting.dictionary nên cũng hiểu code trên , Bạn có giải pháp nào mà không đụng đến CreateObject("scripting.dictionary") không ?

ko xài dic thì đâp nó xuống sheet rồi dùng advancer lọc ra.....hêhehehehe
góp thêm một đoạn code cho vui
anh QuangHai làm nhanh quá.......tui mò từ sáng tới giờ............định bỏ cuộc mấy phen...hhehehehe

Sub chuoichuoi()
Dim arr As Variant, kq(), i As Long, d As Object, chuoi, chuoi2 As String
arr = [c3:c5].Value
Set d = CreateObject("scripting.dictionary")

For i = 1 To UBound(arr)
    For j = i To UBound(arr)
        If i = j And Not IsEmpty(arr(i, 1)) Then chuoi = arr(i, 1)
        If j > i And Not IsEmpty(arr(i, 1)) And Not IsEmpty(arr(j, 1)) Then chuoi = chuoi & arr(j, 1)
        If Not d.exists(chuoi) Then
            k = k + 1
            d.Add chuoi, ""
            ReDim Preserve kq(1 To k)
            kq(k) = chuoi
        End If
        If j > i And Not IsEmpty(arr(i, 1)) And Not IsEmpty(arr(j, 1)) Then chuoi2 = arr(i, 1) & arr(j, 1)
        If Not d.exists(chuoi2) Then
            k = k + 1
            d.Add chuoi2, ""
            ReDim Preserve kq(1 To k)
            kq(k) = chuoi2
        End If
    Next
Next i
[b22].Resize(, k).Value = kq
Set d = Nothing
End Sub

 

[Quang_Hải]

ko xài dic thì đâp nó xuống sheet rồi dùng advancer lọc ra.....hêhehehehe
góp thêm một đoạn code cho vui
anh QuangHai làm nhanh quá.......tui mò từ sáng tới giờ............định bỏ cuộc mấy phen...hhehehehe

Bài toán này mình đoán là phải khai báo Dic là biến toàn cục, vì mỗi lần thay đổi nội dung trong C3:C5 thì những gì đã có trong Combo không bị mất. Cũng không chắc lắm. Toàn là đoán đoán mần thí thí. Không trúng tự nhiên sẽ có hồi báo từ khổ chủ liền

......tui mò từ sáng tới giờ............định bỏ cuộc mấy phen...hhehehehe

Ai kêu tính xa quá chi ráng chịu. Tính sơ sơ thôi, khi nào sai thì tính tiếp.