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

Liên hệ QC

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
Web KT

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

Back
Top Bottom