giúp code lọc dữ liệu từ ngày đến ngày trên Form (1 người xem)

Người dùng đang xem chủ đề này

Giúp em với mọi người ơi!
 
Upvote 0
Code thì như thế này, bạn tùy biến thêm để phù hợp. Cột Listbox bạn thiết đặt độ rộng =0 thì chỉnh cho chuẩn lại sẽ thấy đủ dữ liệu.
Mã:
Sub DateFilter()
    Dim Arr, Res
    Dim i As Long
    Dim Tmp As String
    Dim fDate As Date
    Dim tDate As Date
    fDate = TextBox1.Value
    tDate = TextBox2.Value
    Arr = Sheet1.Range("A3:Z" & Sheet1.Range("A65536").End(3).Row)
ReDim Res(1 To UBound(Arr, 1), 1 To 8)


For i = 1 To UBound(Arr, 1)
    Tmp = DateSerial(Right(Arr(i, 8), 4), Mid(Arr(i, 8), 4, 2), Left(Arr(i, 8), 2))
    If Tmp >= fDate And Tmp <= tDate Then
        k = k + 1
        Res(k, 1) = Arr(i, 1)   'Ten
        Res(k, 2) = Arr(i, 2)   'Nam
        Res(k, 3) = Arr(i, 3)   'Nu
        Res(k, 4) = Arr(i, 4)   'So the BHYT
        Res(k, 5) = Arr(i, 8)   'Ngay kham
        Res(k, 6) = Arr(i, 12)  'Tien thuoc
        Res(k, 7) = Arr(i, 18)  'Cong kham
        Res(k, 8) = Arr(i, 22)  'Tong cong
    End If
Next
Me.ListBox1.List = Res
End Sub
 
Upvote 0
Code thì như thế này, bạn tùy biến thêm để phù hợp. Cột Listbox bạn thiết đặt độ rộng =0 thì chỉnh cho chuẩn lại sẽ thấy đủ dữ liệu.
Mã:
Sub DateFilter()
    Dim Arr, Res
    Dim i As Long
    Dim Tmp As String
    Dim fDate As Date
    Dim tDate As Date
    fDate = TextBox1.Value
    tDate = TextBox2.Value
    Arr = Sheet1.Range("A3:Z" & Sheet1.Range("A65536").End(3).Row)
ReDim Res(1 To UBound(Arr, 1), 1 To 8)


For i = 1 To UBound(Arr, 1)
    Tmp = DateSerial(Right(Arr(i, 8), 4), Mid(Arr(i, 8), 4, 2), Left(Arr(i, 8), 2))
    If Tmp >= fDate And Tmp <= tDate Then
        k = k + 1
        Res(k, 1) = Arr(i, 1)   'Ten
        Res(k, 2) = Arr(i, 2)   'Nam
        Res(k, 3) = Arr(i, 3)   'Nu
        Res(k, 4) = Arr(i, 4)   'So the BHYT
        Res(k, 5) = Arr(i, 8)   'Ngay kham
        Res(k, 6) = Arr(i, 12)  'Tien thuoc
        Res(k, 7) = Arr(i, 18)  'Cong kham
        Res(k, 8) = Arr(i, 22)  'Tong cong
    End If
Next
Me.ListBox1.List = Res
End Sub
Cảm ơn anh em làm được rồi ạ!
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom