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