Private Sub cbMa_Change()
Dim Dat As Date, Rws As Long, W As Byte
Dim Rng As Range, sRng As Range, Sh As Worksheet
Dim MyAdd As String
Dat = DateSerial(CInt(Me!lblNam.Caption), CInt(Me!lblThang.Caption), CInt(Me!cbNgay.Text))
Set Sh = ThisWorkbook.Worksheets("DuLieu")
Rws = Sh.[B2].CurrentRegion.Rows.Count
Set Rng = Sh.Cells(1, 2 * Day(Dat)).Resize(Rws)
Set sRng = Rng.Find(Me!cbMa.Text, , xlFormulas, xlPart)
ReDim Arr(1 To 14, 1 To 3)
If sRng Is Nothing Then
MsgBox "Nothing!"
Me!lbDS.List = Arr()
Else
MyAdd = sRng.Address
Do
W = W + 1
Arr(W, 2) = sRng.Value: Arr(W, 1) = W
Arr(W, 3) = sRng.Offset(, 1).Value
If W = 13 Then
Arr(14, 2) = ". . .": Arr(14, 3) = ". . ."
Arr(14, 1) = 14: Exit Do
End If
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
If W Then
Me!lbDS.List = Arr()
End If
End If
End Sub