Option Explicit
Private dulieu()
Private Sub cbMAY_Change()
Filter_Listbox 5
End Sub
Private Sub cbMH_Change()
Filter_Listbox 3
End Sub
Private Sub cbPO_Change()
Filter_Listbox 1
End Sub
Private Sub cbKH_Change()
Filter_Listbox 2
End Sub
Private Sub cbNSX_Change()
Filter_Listbox 4
End Sub
Sub Filter_Listbox(ByVal col As Long)
Dim r As Long, c As Long, count As Long, chisodong, key, combo(), ketqua()
Dim dic As Object
combo = Array(cbPO, cbKH, cbMH, cbNSX, cbMAY)
' xoa cac combobox sau combobox hien hanh
For c = col To UBound(combo)
combo(c).Clear
Next c
' phuc vu truong hop xoa phan Edit cua combobox nao do
With combo(col - 1)
If .ListIndex < 0 Then
If .text = "" Then
If col = 1 Then
Me.lbufbaocao.List = dulieu
Else
Filter_Listbox col - 1
End If
Else
.text = ""
End If
Exit Sub
End If
End With
' mang chi so cac dong ma o do co gia tri cua combobox hien hanh
With combo(col - 1)
chisodong = Split(.List(.ListIndex, 1), ",")
End With
ReDim ketqua(1 To UBound(chisodong) - LBound(chisodong) + 1, 1 To 5)
If col < 5 Then
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
End If
' duyet mang dulieu
For r = LBound(chisodong, 1) To UBound(chisodong, 1)
count = count + 1
For c = 1 To 5
ketqua(count, c) = dulieu(CLng(chisodong(r)), c)
Next c
' xac dinh chi so cac dong ma o do co tung gia tri cu the cua combobox ngay sau combobox hien hanh
If col < 5 Then
key = dulieu(CLng(chisodong(r)), col + 1) ' gia tri cua combobox ngay sau combobox hien hanh
If Not dic.exists(key) Then
dic.Add key, chisodong(r)
Else
dic.item(key) = dic.item(key) & "," & chisodong(r)
End If
End If
Next r
Me.lbufbaocao.List = ketqua
If col < 5 Then
' nhap cac muc cho combobox sau combobox hien hanh
ReDim ketqua(1 To dic.count, 1 To 2)
r = 0
For Each key In dic.keys
r = r + 1
ketqua(r, 1) = key
ketqua(r, 2) = dic.item(key)
Next key
combo(col).List = ketqua
End If
End Sub
Private Sub UserForm_Initialize()
Dim lastRow As Long, r As Long, key, dh()
Dim dic As Object
' lay du lieu vao mang dulieu
With ThisWorkbook.Sheets("KHSX")
lastRow = .Cells(Rows.count, "B").End(xlUp).Row
If lastRow < 4 Then Exit Sub
dulieu = .Range("B4:K" & lastRow).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(dulieu, 1)
dulieu(r, 4) = dulieu(r, 5) ' ghi cot NGAY SX vao cot 4
dulieu(r, 5) = dulieu(r, 8) ' ghi cot MAY vao cot 5
key = dulieu(r, 1)
' voi moi DH ghi cac chi so dong ma o do co DH cu the. Cac chi so cach nhau boi dau phay ","
If Len(key) Then
If Not dic.exists(key) Then
dic.Add key, CStr(r)
Else
dic.item(key) = dic.item(key) & "," & r
End If
End If
Next r
ReDim dh(1 To dic.count, 1 To 2)
r = 0
For Each key In dic.keys
r = r + 1
dh(r, 1) = key
dh(r, 2) = dic.item(key)
Next key
Me.cbPO.List = dh
' chi de du lieu 5 cot
ReDim Preserve dulieu(1 To UBound(dulieu, 1), 1 To 5)
lbufbaocao.List = dulieu
Set dic = Nothing
End Sub
Private Sub cmdDongForm_Click()
Unload Me
End Sub
Private Sub cmdLamMoiForm_Click()
'Dim iRow As Long, i As Long, MyCtrls()
'MyCtrls = Array(cbPO, cbKH, cbMH, cbNSX, cbMAY)
'Range("lbufbaocao").Offset(lbufbaocao.ListIndex).Resize(1).Value = MyCtrls
'For i = 0 To 9
'MyControls(i).Text = ""
'Next
cbPO.text = ""
cbKH.text = ""
cbMH.text = ""
cbNSX.text = ""
cbMAY.text = ""
'MsgBox "FORM TRONG, MOI BAN NHAP THONG TIN KHACH HANG ", vbExclamation, "MOI BAN NHAP THONG TIN KHACH HANG"
End Sub
Bao Cao File
