Lọc danh sách thành duy nhất rồi gán cho Combo box (1 người xem)

[USB1394]

Mình có 1 DS dữ liệu (gồm nhiều dòng , có dòng có dữ liệu , có dòng không = rỗng) . Vấn đề là dùng code như thế nào để lọc danh sách đó (trong VD là cột màu đỏ) thành :
1. Danh sách duy nhất không trùng lập , không có ô rỗng
2. Gán DS đó lên combo box trên form để sử dụng
Rất mong các Bạn giúp đỡ , xin cám ơn

 

[Hoàng Trọng Nghĩa]

Mình có 1 DS dữ liệu (gồm nhiều dòng , có dòng có dữ liệu , có dòng không = rỗng) . Vấn đề là dùng code như thế nào để lọc danh sách đó (trong VD là cột màu đỏ) thành :
1. Danh sách duy nhất không trùng lập , không có ô rỗng
2. Gán DS đó lên combo box trên form để sử dụng
Rất mong các Bạn giúp đỡ , xin cám ơn

Nếu bạn tham khảo tại topic này mà vẫn không biết cách làm thì tôi sẽ giúp cho bạn!


Tặng hàm [ Unique2D ] tùy chọn cột hiển thị sau khi lọc duy nhất.

 

[USB1394]

Nhìn vào code trong hàm thấy không nhiều mà sao sao nó "mạnh dữ" làm mình sỉn luôn , không biết mò từ đâu ! Nhờ câu thần chú này nhé : "tức là lọc gì đó trên 1 CSDL và trích ra bao nhiêu field tùy ý" . Xin cám ơn bạn rất nhiều . Phải ngâm cứu cái đã

 

[Hoàng Trọng Nghĩa]

Nhìn vào code trong hàm thấy không nhiều mà sao sao nó "mạnh dữ" làm mình sỉn luôn , không biết mò từ đâu ! Nhờ câu thần chú này nhé : "tức là lọc gì đó trên 1 CSDL và trích ra bao nhiêu field tùy ý" . Xin cám ơn bạn rất nhiều . Phải ngâm cứu cái đã

Để cho thấy "sức mạnh" thực sự của nó, thì sau khi chép Function về, bạn chỉ cần câu "thần chú" này:

Private Sub UserForm_Initialize()
    [COLOR=#0000ff][B]ComboBox1.List = [/B][/COLOR][COLOR=#ff0000][B]UNIQUE2D[/B][/COLOR][COLOR=#0000ff][B](Range(Sheet1.[D7], Sheet1.[D65536].End(xlUp)))[/B][/COLOR]
End Sub

Vấn đề của bạn đã được giải quyết!

P/s: May mắn cho bạn là file này tôi đã cải tiến cho hàm rồi đấy nhé!

 

[USB1394]

Cám ơn bạn đã giúp đỡ , trước mắt đã giải quyết vấn đề , mình cần nghiên cứu thêm để áp dụng rộng rãi , thanks

 

[Quang_Hải]

Mình có 1 DS dữ liệu (gồm nhiều dòng , có dòng có dữ liệu , có dòng không = rỗng) . Vấn đề là dùng code như thế nào để lọc danh sách đó (trong VD là cột màu đỏ) thành :
1. Danh sách duy nhất không trùng lập , không có ô rỗng
2. Gán DS đó lên combo box trên form để sử dụng
Rất mong các Bạn giúp đỡ , xin cám ơn

Tham khảo thêm code đơn giản này nhá
Nếu muốn làm quen với VBA thì nên tiếp cận code cơ bản thế này. Code của anh HTN thì có thể dùng nhưng hiểu được thì có lẻ mất 3 năm sau. Code của mình chỉ cần 1 ngày là học được đấy.

Private Sub UserForm_Initialize()
Dim ds(), item
ds = Sheet1.Range(Sheet1.[D7], Sheet1.[D65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For Each item In ds
      If item <> "" Then
         If Not .exists(item) Then
            .Add item, ""
            UserForm1.ComboBox1.AddItem item
         End If
      End If
   Next
End With
End Sub

 

[DMQ]

Các AC cho em hỏi là : Code trên lọc từ 1 sheet(Sheet1). Thế nếu lọc cả 2 sheet(sheet1 và sheet2) rồi đưa vào combobox thì code viết sao ah?????

 

[Quang_Hải]

Các AC cho em hỏi là : Code trên lọc từ 1 sheet(Sheet1). Thế nếu lọc cả 2 sheet(sheet1 và sheet2) rồi đưa vào combobox thì code viết sao ah?????

Sửa code bài 6 thành thế này

Private Sub UserForm_Initialize()
Dim ds(), item, ShName(), Dic As Object
Set Dic = CreateObject("scripting.dictionary")
ShName = Array("Sheet1", "sheet2")
For i = 0 To UBound(ShName)
   With Sheets(ShName(i))
      ds = .Range("D7", .[D65536].End(3)).Value
      For Each item In ds
         If item <> "" Then Dic(item) = ""
      Next
   End With
Next
Me.ComboBox1.List = Dic.keys
End Sub

 

[DMQ]

Xin lỗi Anh QuangHai1969 là em quên nói là khác cột luôn thì sao Anh( ví dụ như Cột C sheet 1 và cột J sheet 2)

 

[ndu96081631]

Xin lỗi Anh QuangHai1969 là em quên nói là khác cột luôn thì sao Anh( ví dụ như Cột C sheet 1 và cột J sheet 2)

Lúc trước tôi có viết hàm UniqueList thế này:

Function UniqueList(ParamArray SourceArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In SourceArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        If TypeName(Item) <> "Error" Then
          tmp = CStr(Item)
          If Len(tmp) Then
            If Not .Exists(tmp) Then .Add tmp, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

Việc của bạn là áp dụng thôi:

Private Sub UserForm_Initialize()
  Dim arr
  arr = UniqueList([COLOR=#0000cd]Sheet1.Range("C2:C1000"), Sheet2.Range("J2:J1000")[/COLOR])
  If IsArray(arr) Then ComboBox1.List = arr
End Sub

Chỗ màu xanh là dữ liệu của bạn, có bao nhiêu cứ việc liệt kê thoải mái vào

 

[DMQ]

Em đã làm được rồi.Cám ơn Thầy. Giờ em vướng tiếp chổ này Ah:
Khi combobox thay đổi(Sub cb_DH_Change) thì lọc dữ liệu cột M của sheet2 vào tb_SLCD và lọc dữ liệu của cột E và cột F của sheet3 vào ListBox1. Thì code viết làm sao hả Thầy?????

 

[DMQ]

Em xin đưa file lên, mong Thầy và mọi người giúp em.

 

[nmhung49]

Em xin đưa file lên, mong Thầy và mọi người giúp em.

Bạn thay thành đoạn code này xem

[GPECODE=vb]
Private Sub cb_DH_Change()
Dim MT(), CDDH, mc As String, i As Long, k As Long, tong As Double
ListBox1.Clear
mc = Trim(cb_DH.Value)
MT = Sheet3.Range(Sheet3.[C4], Sheet3.[C65536].End(xlUp)).Resize(, 4).Value
Me.tb_SLCD = Format(Sheet2.Range("J:J").Find(mc).Offset(, 3).Value, "#,##0")

For i = 1 To UBound(MT)
If Trim(MT(i, 1)) = mc Then
With ListBox1
.AddItem ""
.List(k, 0) = MT(i, 3)
.List(k, 1) = Format(MT(i, 4), "#,##0")
End With
k = k + 1
End If
Next
End Sub


[/GPECODE]

 

[dhn46]

Tách thành 2 Sub cho bạn dễ nhìn

Sub SLMT()
    Dim Arr()
    Dim i As Long, Qty As Double
    Arr = Sheet2.Range(Sheet2.[J4], Sheet2.[J65536].End(xlUp)).Resize(, 4).Value
    For i = 1 To UBound(Arr, 1)
        If CStr(Arr(i, 1)) = Me.cb_DH Then
            Qty = Qty + Arr(i, 4)
        End If
    Next
    Me.tb_SLMT = Qty
End Sub
Sub LB()
    Dim ArrLb(), ResLb
    Dim i As Long, k As Long
    ArrLb = Sheet3.Range(Sheet3.[C4], Sheet3.[C65536].End(xlUp)).Resize(, 4).Value
    ReDim ResLb(1 To UBound(ArrLb, 1), 1 To 2)
    For i = 1 To UBound(ArrLb, 1)
        If CStr(ArrLb(i, 1)) = Me.cb_DH Then
            k = k + 1
            Debug.Print ArrLb(i, 3)
            ResLb(k, 1) = ArrLb(i, 3)
            ResLb(k, 2) = ArrLb(i, 4)
        End If
    Next
    Me.ListBox1.Clear
    Me.ListBox1.List = ResLb
    Me.ListBox1.ColumnCount = 2
End Sub

Tại sự kiện dưới đây thì gọi 2 sub ở cuối

Private Sub cb_DH_Change()
.................


    Call SLMT
    Call LB
End Sub

[/code[

 

[DMQ]

Sub LB không thực hiện được bạn dhn46 ah!!! Làm sao để ghi được Móc treo và số lượng móc treo của đơn hàng trong combobox vào listbox, sau đó chọn trong listbox để hiện qua textbox rồi sửa. Mong Bạn và Các AC giúp đở!!!!

 

[DMQ]

Code của bạn nmhung49 thì có ghi vào listbox,nhưng số lượng móc treo(.(List(k, 1) = Format(MT(i, 4), "#,##0") thì không có. Và đơn hàng nào không có số lượng cân đối thì tb_SLCD bằng """(của bạn bị lỗi-debug) như đơn 3506 không có số lượng cân đối.

 

[DMQ]

Xin lỗi code của bạn dhn46 là đúng rồi(vì bạn lộn tb_SLMT-Thay vì tb_SLCD). Giờ giúp em nút "Sửa" với!!!!!

 

[DMQ]

Em mới sưu tầm code của Thầy Sealand vào Form mà sửa không được, Mong các AC giúp em với!!!!!

 

[DMQ]

Tại sao em chèn code của Thầy Sealand vào mà sửa không được!!!

Private Sub CmdSua_Click()Dim Cl As Range, Ch1, Ch2
Set Cl = Sheet3.Columns("E").Find(what:=Me.ListBox1)
Ch1 = tb_MT.Text
Ch2 = tb_SLMT.Text
Cl.Value = Ch1
Cl.Offset(, 1).Value = Ch2
    MsgBox "Da Sua Xong", , "GPE"
End Sub