Hỏi cách đặt điều kiện trong OptionButon (1 người xem)

quoc nhat · 13/11/15

Chào các anh chị
Em muốn hỏi cách đặt điều kiện cho một biến lớn hơn 0 (>0) trong code sau như thế nào mà em làm nó cứ báo là:
Compiler error: Expectex expression

Mã:

Private Sub OptionButton1_Change()
Dim dk As String
If OptionButton1 = True Then
[B][COLOR=#ff0000]dk > 0[/COLOR][/B]
End If
End Sub
[code/]
Mong được chỉ bảo ạ!

quoc nhat · 13/11/15

hpkhuong đã viết:
Hok biết bạn làm gì nhưng thấy khai báo
Dim dk As String
Thì biểu thức này Dk> 0 đâu có ý nghĩa gì nhỉ??? . Vì hiễn nhiên ở As String thì luôn luôn là chuỗi nên nó phải lớn hơn không rồi...

Mình khai báo nhầm ấy mà
Dim dk as long

Ý mình muốn lọc theo điều kiện khi nhấn OptionButon
Nhưng cái chọn điều kiện lọc mình chưa làm được nên hỏi

quoc nhat · 13/11/15

hpkhuong đã viết:
Kèm file lên đây. Và trình bày điều mình muốn...nhé!

File của mình đây
http://www.mediafire.com/view/jo4bt3a72i6wwzx/Copy_of_data1(2).xls

lọc theo điều kiện từ ngày đến ngày trên form
nhập ngày cần lọc vào 2 textbox ở trên form
chọn thêm điều kiện lọc nữa là Optionbuton
- Optionbuton 1(chuyển tuyến): lọc cột 12 sheet11 những giá trị = 0
- Optionbuton 2(khám bệnh): lọc cột 12 sheet11 những giá trị > 0
- Optionbuton 3(chuyển tuyến): lọc cột 12 sheet11 những giá trị >= 0
Ý em muốn như vậy
anh giúp giùm em với

befaint · 13/11/15

quoc nhat đã viết:
Mình khai báo nhầm ấy mà
Dim dk as long

Ý mình muốn lọc theo điều kiện khi nhấn OptionButon
Nhưng cái chọn điều kiện lọc mình chưa làm được nên hỏi

Bạn xem file đính kèm xem có áp dụng được gì cho trường hợp của bạn không?

befaint · 13/11/15

quoc nhat đã viết:
File của mình đây
http://www.mediafire.com/view/jo4bt3a72i6wwzx/Copy_of_data1(2).xls

lọc theo điều kiện từ ngày đến ngày trên form
nhập ngày cần lọc vào 2 textbox ở trên form
chọn thêm điều kiện lọc nữa là Optionbuton
- Optionbuton 1(chuyển tuyến): lọc cột 12 sheet11 những giá trị = 0
- Optionbuton 2(khám bệnh): lọc cột 12 sheet11 những giá trị > 0
- Optionbuton 3(chuyển tuyến): lọc cột 12 sheet11 những giá trị >= 0
Ý em muốn như vậy
anh giúp giùm em với

Tôi nghĩ là dùng checkbox thì hay hơn chứ, khi đó lọc kết hợp các điều kiện dễ dàng hơn.

quoc nhat · 13/11/15

befaint đã viết:
Bạn xem file đính kèm xem có áp dụng được gì cho trường hợp của bạn không?

mình đang dùng win xp không đọc file bạn gửi được bạn gửi lại được không

giaiphap · 13/11/15

quoc nhat đã viết:
mình đang dùng win xp không đọc file bạn gửi được bạn gửi lại được không

Đọc file này là office chứ không phải win bạn ơi.

befaint · 13/11/15

quoc nhat đã viết:
mình đang dùng win xp không đọc file bạn gửi được bạn gửi lại được không

Tôi up lại file ở bài #6 rồi nhé.
p/s: windows xp đâu liên quan gì tới việc mở file? +-+-+-+

quoc nhat · 13/11/15

befaint đã viết:
Tôi up lại file ở bài #6 rồi nhé.
p/s: windows xp đâu liên quan gì tới việc mở file?

office của mình chỉ đọc được đuôi .xls thôi bạn ơi

giaiphap · 13/11/15

quoc nhat đã viết:
office của mình chỉ đọc được đuôi .xls thôi bạn ơi

Thì ở #6 đã đổi lại file xls cho bạn rồi còn gì

quoc nhat · 13/11/15

hpkhuong đã viết:

Thôi gắn code cho từng OptionButton vậy.... (Tôi lấy code trong file của bạn, chỉnh lại cho 3 cái OptionButton này...)Bạn xem dùng được thì dùng...
Gõ ngày vào 2 textbox. Sau đó click vào từng OptionButton tương ứng thì listbox ở dưới nó load lại. Còn muốn lóad hết lên thì bạn ấn cái Cmb gì đó bình thường của bạn

Mã:

Private Sub OptionButton1_Change()
On Error Resume Next
ListBox1.Clear
If Tu = "" Or Den = "" Then
Exit Sub
Else
 Dim Arr, Res
    Dim i As Long, K As Long, t As Long
    Dim Tmp As String
    Dim fDate As Date
    Dim tDate As Date
    Dim tongcong As Long
    tongcong = 0
    fDate = DateSerial(Right(Tu.Value, 4), Mid(Tu.Value, 4, 2), Left(Tu.Value, 2))
    tDate = DateSerial(Right(Den.Value, 4), Mid(Den.Value, 4, 2), Left(Den.Value, 2))
    Arr = Sheet11.Range("A3:Z" & Sheet11.Range("A65536").End(3).Row)
ReDim Res(1 To UBound(Arr, 1), 1 To 9)
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 And Arr(i, 12) = 0 Then
        K = K + 1
        Res(K, 1) = K 'stt
        Res(K, 2) = Arr(i, 1)   'Ten
        If Arr(i, 2) = "" Then
        Res(K, 3) = Arr(i, 3)   'Nam
        Else
        Res(K, 3) = Arr(i, 2)   'Nu
        End If
        Res(K, 4) = Arr(i, 4)   'So the BHYT
        Res(K, 5) = Arr(i, 8)   'Ngay kham
        If Arr(i, 12) = 0 Then
        Res(K, 6) = 0
        Else
        Res(K, 6) = Arr(i, 12)  'Tien thuoc
        Res(K, 6) = Format(Res(K, 6), "#,###")
        End If
        If Arr(i, 13) = 0 Then ' Thu thuat
        Res(K, 7) = 0
        Else
        Res(K, 7) = Arr(i, 13)  'Thu thuat
        Res(K, 7) = Format(Res(K, 7), "#,###")
        End If
        Res(K, 8) = Arr(i, 18)  'Tong cong
         Res(K, 8) = Format(Res(K, 8), "#,###")
         Res(K, 9) = Arr(i, 22)  'Tong cong
         Res(K, 9) = Format(Res(K, 9), "#,###")
         tongcong = tongcong + Res(K, 9)
         End If
        
Next i
TextBox5.Value = tongcong
TextBox5 = Format(TextBox5, "#,###")
ListBox1.Width = 680.2
ListBox1.Height = 254.8
Me.ListBox1.List = Res
Me.TextBox2.Value = K 'Me.ListBox1.ListIndex
End If
End Sub

Mã:

Private Sub OptionButton2_Change()
On Error Resume Next
ListBox1.Clear
If Tu = "" Or Den = "" Then
Exit Sub
Else
 Dim Arr, Res
    Dim i As Long, K As Long, t As Long
    Dim Tmp As String
    Dim fDate As Date
    Dim tDate As Date
    Dim tongcong As Long
    tongcong = 0
    fDate = DateSerial(Right(Tu.Value, 4), Mid(Tu.Value, 4, 2), Left(Tu.Value, 2))
    tDate = DateSerial(Right(Den.Value, 4), Mid(Den.Value, 4, 2), Left(Den.Value, 2))
    Arr = Sheet11.Range("A3:Z" & Sheet11.Range("A65536").End(3).Row)
ReDim Res(1 To UBound(Arr, 1), 1 To 9)
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 And Arr(i, 12) > 0 Then
        K = K + 1
        Res(K, 1) = K 'stt
        Res(K, 2) = Arr(i, 1)   'Ten
        If Arr(i, 2) = "" Then
        Res(K, 3) = Arr(i, 3)   'Nam
        Else
        Res(K, 3) = Arr(i, 2)   'Nu
        End If
        Res(K, 4) = Arr(i, 4)   'So the BHYT
        Res(K, 5) = Arr(i, 8)   'Ngay kham
        If Arr(i, 12) = 0 Then
        Res(K, 6) = 0
        Else
        Res(K, 6) = Arr(i, 12)  'Tien thuoc
        Res(K, 6) = Format(Res(K, 6), "#,###")
        End If
        If Arr(i, 13) = 0 Then ' Thu thuat
        Res(K, 7) = 0
        Else
        Res(K, 7) = Arr(i, 13)  'Thu thuat
        Res(K, 7) = Format(Res(K, 7), "#,###")
        End If
        Res(K, 8) = Arr(i, 18)  'Tong cong
         Res(K, 8) = Format(Res(K, 8), "#,###")
         Res(K, 9) = Arr(i, 22)  'Tong cong
         Res(K, 9) = Format(Res(K, 9), "#,###")
         tongcong = tongcong + Res(K, 9)
         End If
        
Next i
TextBox5.Value = tongcong
TextBox5 = Format(TextBox5, "#,###")
ListBox1.Width = 680.2
ListBox1.Height = 254.8
Me.ListBox1.List = Res
Me.TextBox2.Value = K 'Me.ListBox1.ListIndex
End If
End Sub

Mã:

Private Sub OptionButton3_Change()
On Error Resume Next
ListBox1.Clear
If Tu = "" Or Den = "" Then
Exit Sub
Else
 Dim Arr, Res
    Dim i As Long, K As Long, t As Long
    Dim Tmp As String
    Dim fDate As Date
    Dim tDate As Date
    Dim tongcong As Long
    tongcong = 0
    fDate = DateSerial(Right(Tu.Value, 4), Mid(Tu.Value, 4, 2), Left(Tu.Value, 2))
    tDate = DateSerial(Right(Den.Value, 4), Mid(Den.Value, 4, 2), Left(Den.Value, 2))
    Arr = Sheet11.Range("A3:Z" & Sheet11.Range("A65536").End(3).Row)
ReDim Res(1 To UBound(Arr, 1), 1 To 9)
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 And Arr(i, 12) >= 0 Then
        K = K + 1
        Res(K, 1) = K 'stt
        Res(K, 2) = Arr(i, 1)   'Ten
        If Arr(i, 2) = "" Then
        Res(K, 3) = Arr(i, 3)   'Nam
        Else
        Res(K, 3) = Arr(i, 2)   'Nu
        End If
        Res(K, 4) = Arr(i, 4)   'So the BHYT
        Res(K, 5) = Arr(i, 8)   'Ngay kham
        If Arr(i, 12) = 0 Then
        Res(K, 6) = 0
        Else
        Res(K, 6) = Arr(i, 12)  'Tien thuoc
        Res(K, 6) = Format(Res(K, 6), "#,###")
        End If
        If Arr(i, 13) = 0 Then ' Thu thuat
        Res(K, 7) = 0
        Else
        Res(K, 7) = Arr(i, 13)  'Thu thuat
        Res(K, 7) = Format(Res(K, 7), "#,###")
        End If
        Res(K, 8) = Arr(i, 18)  'Tong cong
         Res(K, 8) = Format(Res(K, 8), "#,###")
         Res(K, 9) = Arr(i, 22)  'Tong cong
         Res(K, 9) = Format(Res(K, 9), "#,###")
         tongcong = tongcong + Res(K, 9)
         End If
        
Next i
TextBox5.Value = tongcong
TextBox5 = Format(TextBox5, "#,###")
ListBox1.Width = 680.2
ListBox1.Height = 254.8
Me.ListBox1.List = Res
Me.TextBox2.Value = K 'Me.ListBox1.ListIndex
End If
End Sub

chỉ cách này thôi hả anh
ngoài ra không còn cách nào khác nữa ạ

doveandrose · 13/11/15

quoc nhat đã viết:
chỉ cách này thôi hả anh
ngoài ra không còn cách nào khác nữa ạ

cách của ông Trùm có vấn đề gì à ?

quoc nhat · 13/11/15

doveandrose đã viết:
cách của ông Trùm có vấn đề gì à ?

Không ạ.
em chỉ muốn chọn điều kiện lọc xong nhấn vào nút lọc ấy ạ

sealand · 13/11/15

Khiếp, của nhà làm ra nên anh em cho nhau thoải mái, quá là dư giả.
Mình thi chỉ dựa vào đồ tín chủ mà Modify, Code của Form mình bớt xén chỉ còn thế này thôi, cứ thử xem sao:

Mã:

Private Sub CommandButton1_Click()
Unload Me
End Sub

'---------------------------------------------
Private Sub CommandButton3_Click()
    Dim Arr, Res(), i As Long, K As Long, t As Long, mOk As Integer
    Dim Tmp As Date, fDate As Date, tDate As Date, tongcong As Long
        
        On Error Resume Next
        ListBox1.Clear
        If Tu.Value = "" Or Den.Value = "" Then Exit Sub
    fDate = DateSerial(Right(Tu.Value, 4), Mid(Tu.Value, 4, 2), Left(Tu.Value, 2))
    tDate = DateSerial(Right(Den.Value, 4), Mid(Den.Value, 4, 2), Left(Den.Value, 2))
    Arr = Sheet11.Range("A3:Z" & Sheet11.Range("A65536").End(3).Row)
        For i = 1 To UBound(Arr, 1)
            If fDate <= DateSerial(Right(Arr(i, 8), 4), Mid(Arr(i, 8), 4, 2), Left(Arr(i, 8), 2)) And tDate >= _
            DateSerial(Right(Arr(i, 8), 4), Mid(Arr(i, 8), 4, 2), Left(Arr(i, 8), 2)) Then mOk = 1
            If Me.OptionButton1 = True And Arr(i, 12) = 0 Then mOk = mOk + 1
            If Me.OptionButton2 = True And Arr(i, 12) > 0 Then mOk = mOk + 1
            If Me.OptionButton3 = True Then mOk = mOk + 1
    If mOk = 2 Then
        K = K + 1
        ReDim Preserve Res(1 To 9, 1 To K)
        Res(1, K) = K 'stt
        Res(2, K) = Arr(i, 1)   'Ten
        Res(3, K) = IIf(Arr(i, 2) = "", Arr(i, 3), Arr(i, 2))
        Res(4, K) = Arr(i, 4)   'So the BHYT
        Res(5, K) = Arr(i, 8)   'Ngay kham
        Res(6, K) = IIf(Arr(i, 12) = 0, 0, Format(Arr(i, 12), "#,###"))
        Res(7, K) = IIf(Arr(i, 13) = 0, 0, Format(Arr(i, 13), "#,###"))
        Res(8, K) = Format(Arr(i, 18), "#,###")  'Tong cong
        Res(9, K) = Format(Arr(i, 22), "#,###")
        tongcong = tongcong + Arr(i, 22)
        End If
        
    Next i
            TextBox5 = Format(tongcong, "#,###")
            ListBox1.Width = 680.2
            ListBox1.Height = 254.8
            Me.ListBox1.List = WorksheetFunction.Transpose(Res)
            Me.TextBox2.Value = K
End Sub

'--------------------------------------
Private Sub UserForm_Initialize()
Me.OptionButton3 = True
End Sub

Có vấn đề hình như sai thì phải, không điền lại tên nên chỗ trống nó cắm râu ông nọ vào cằm bà kia. Có thể sửa code để nó điền từ ngày đến ngày kiểu 1.5.2015 thay dai dòng 01.05.2015. Mình định sửa nhưng chưa biết ý tác giả sao nữa?

quoc nhat · 14/11/15

sealand đã viết:

Khiếp, của nhà làm ra nên anh em cho nhau thoải mái, quá là dư giả.
Mình thi chỉ dựa vào đồ tín chủ mà Modify, Code của Form mình bớt xén chỉ còn thế này thôi, cứ thử xem sao:

Mã:

Private Sub CommandButton1_Click()
Unload Me
End Sub

'---------------------------------------------
Private Sub CommandButton3_Click()
    Dim Arr, Res(), i As Long, K As Long, t As Long, mOk As Integer
    Dim Tmp As Date, fDate As Date, tDate As Date, tongcong As Long
        
        On Error Resume Next
        ListBox1.Clear
        If Tu.Value = "" Or Den.Value = "" Then Exit Sub
    fDate = DateSerial(Right(Tu.Value, 4), Mid(Tu.Value, 4, 2), Left(Tu.Value, 2))
    tDate = DateSerial(Right(Den.Value, 4), Mid(Den.Value, 4, 2), Left(Den.Value, 2))
    Arr = Sheet11.Range("A3:Z" & Sheet11.Range("A65536").End(3).Row)
        For i = 1 To UBound(Arr, 1)
            If fDate <= DateSerial(Right(Arr(i, 8), 4), Mid(Arr(i, 8), 4, 2), Left(Arr(i, 8), 2)) And tDate >= _
            DateSerial(Right(Arr(i, 8), 4), Mid(Arr(i, 8), 4, 2), Left(Arr(i, 8), 2)) Then mOk = 1
            If Me.OptionButton1 = True And Arr(i, 12) = 0 Then mOk = mOk + 1
            If Me.OptionButton2 = True And Arr(i, 12) > 0 Then mOk = mOk + 1
            If Me.OptionButton3 = True Then mOk = mOk + 1
    If mOk = 2 Then
        K = K + 1
        ReDim Preserve Res(1 To 9, 1 To K)
        Res(1, K) = K 'stt
        Res(2, K) = Arr(i, 1)   'Ten
        Res(3, K) = IIf(Arr(i, 2) = "", Arr(i, 3), Arr(i, 2))
        Res(4, K) = Arr(i, 4)   'So the BHYT
        Res(5, K) = Arr(i, 8)   'Ngay kham
        Res(6, K) = IIf(Arr(i, 12) = 0, 0, Format(Arr(i, 12), "#,###"))
        Res(7, K) = IIf(Arr(i, 13) = 0, 0, Format(Arr(i, 13), "#,###"))
        Res(8, K) = Format(Arr(i, 18), "#,###")  'Tong cong
        Res(9, K) = Format(Arr(i, 22), "#,###")
        tongcong = tongcong + Arr(i, 22)
        End If
        
    Next i
            TextBox5 = Format(tongcong, "#,###")
            ListBox1.Width = 680.2
            ListBox1.Height = 254.8
            Me.ListBox1.List = WorksheetFunction.Transpose(Res)
            Me.TextBox2.Value = K
End Sub

'--------------------------------------
Private Sub UserForm_Initialize()
Me.OptionButton3 = True
End Sub

Có vấn đề hình như sai thì phải, không điền lại tên nên chỗ trống nó cắm râu ông nọ vào cằm bà kia. Có thể sửa code để nó điền từ ngày đến ngày kiểu 1.5.2015 thay dai dòng 01.05.2015. Mình định sửa nhưng chưa biết ý tác giả sao nữa?

Dạ như thế được rồi anh. Nhờ từ đầu đến cuối thì em làm sao mà biết cách viết code được. Em chỉ hỏi cách đặt điều kiện thôi chứ mấy cái sai đó em tìm cách sửa lại cũng được.
Cảm ơn anh nhiều!

sealand · 14/11/15

Đây là file mình sửa lại kể cả tiêu đề, nhãn vùng tổng cộng. Bạn Test xem nha

quoc nhat · 16/11/15

sealand đã viết:
Đây là file mình sửa lại kể cả tiêu đề, nhãn vùng tổng cộng. Bạn Test xem nha

Có vẻ không ổn lắm. Số lượng bệnh nhân khi chọn điều kiện lọc nhiều gấp 2-3 lần số bệnh nhân thực tế.
Cảm ơn anh em đã tìm tòi và sửa được ưng ý.
nhưng em sẽ lấy thêm cái tiêu đề trong file của anh mới gửi.. tuyệt thật!!

sealand · 17/11/15

Tôi kiểm tra mới biết 1 người có nhiều loại thuốc thì có nhiều dòng nên khi tổng hợp bị dôi ra.
Code lọc điều chỉnh lại 1 chút

Mã:

Private Sub CommandButton3_Click()
    Dim Arr, Res(), i As Long, K As Long, t As Long, mOk As Integer
    Dim Tmp As Date, fDate As Date, tDate As Date, tongcong As Long
        
        On Error Resume Next
        ListBox1.Clear
        If Tu.Value = "" Or Den.Value = "" Then Exit Sub
        Tu = Replace(Replace(Tu, "/", "."), "-", ".")
        Den = Replace(Replace(Den, "/", "."), "-", ".")
fDate = DateSerial(Split(Tu, ".")(2), Split(Tu, ".")(1), Split(Tu, ".")(0))
tDate = DateSerial(Split(Den, ".")(2), Split(Den, ".")(1), Split(Den, ".")(0))
    Arr = Sheet11.Range("A3:Z" & Sheet11.Range("A65536").End(3).Row)
        For i = 1 To UBound(Arr, 1)
            If fDate <= DateSerial(Split(Arr(i, 8), ".")(2), Split(Arr(i, 8), ".")(1), Split(Arr(i, 8), ".")(0)) And tDate >= _
            DateSerial(Split(Arr(i, 8), ".")(2), Split(Arr(i, 8), ".")(1), Split(Arr(i, 8), ".")(0)) Then mOk = 1
            If Me.OptionButton1 = True And Arr(i, 12) = 0 Then mOk = mOk + 1
            If Me.OptionButton2 = True And Arr(i, 12) > 0 Then mOk = mOk + 1
            If Me.OptionButton3 = True Then mOk = mOk + 1
            If WorksheetFunction.Trim(Arr(i, 1)) = "" Then mOk = 0
            
    If mOk = 2 Then
        K = K + 1
        ReDim Preserve Res(1 To 9, 1 To K)
        Res(1, K) = K
        Res(2, K) = Arr(i, 1)
        Res(3, K) = IIf(Arr(i, 2) = "", Arr(i, 3), Arr(i, 2))
        Res(4, K) = Arr(i, 4)   'So the BHYT
        Res(5, K) = Arr(i, 8)   'Ngay kham
        Res(6, K) = IIf(Arr(i, 12) = 0, 0, Format(Arr(i, 12), "#,###"))
        Res(7, K) = IIf(Arr(i, 13) = 0, 0, Format(Arr(i, 13), "#,###"))
        Res(8, K) = Format(Arr(i, 18), "#,###")  'Tong cong
        Res(9, K) = Format(Arr(i, 22), "#,###")
        tongcong = tongcong + Arr(i, 22)
        End If
        
    Next i
            TextBox5 = Format(tongcong, "#,###")
            ListBox1.Width = 680.2: ListBox1.Height = 254.8
            Me.ListBox1.List = IIf(K < 2, Res, WorksheetFunction.Transpose(Res))
            Me.TextBox2.Value = K
'Dat lai tieu de Form va Tong cong
Me.Label11.Caption = "T" & ChrW(7893) & "ng b" & ChrW(7879) & "nh nh" & ChrW(226) & "n " & IIf(Me.OptionButton2 = True, _
"kh" & ChrW(225) & "m b" & ChrW(7879) & "nh", IIf(Me.OptionButton1 = True, "chuy" & ChrW(7875) & "n tuy" & ChrW(7871) & _
"n", "")) & " t" & ChrW(7915) & " ng" & ChrW(224) & "y " & Format(fDate, "dd/mm/yyyy") & " " & ChrW(273) & ChrW(7871) & _
"n ng" & ChrW(224) & "y " & Format(tDate, "dd/mm/yyyy") & ": "


Me.Label1.Caption = "B" & ChrW(7878) & "NH NH" & ChrW(194) & "N " & IIf(Me.OptionButton2 = True, "KH" & ChrW(193) & _
"M B" & ChrW(7878) & "NH", IIf(Me.OptionButton1 = True, "CHUY" & ChrW(7874) & "N TUY" & ChrW(7870) & "N", "")) & " T" & _
ChrW(7914) & " NG" & ChrW(192) & "Y " & Format(fDate, "DD/MM/YYYY") & " " & ChrW(272) & ChrW(7870) & "N NG" & ChrW(192) & _
"Y " & Format(tDate, "DD/MM/YYYY")


End Sub

quoc nhat · 22/11/15

sealand đã viết:

Tôi kiểm tra mới biết 1 người có nhiều loại thuốc thì có nhiều dòng nên khi tổng hợp bị dôi ra.
Code lọc điều chỉnh lại 1 chút

Mã:

Private Sub CommandButton3_Click()
    Dim Arr, Res(), i As Long, K As Long, t As Long, mOk As Integer
    Dim Tmp As Date, fDate As Date, tDate As Date, tongcong As Long
        
        On Error Resume Next
        ListBox1.Clear
        If Tu.Value = "" Or Den.Value = "" Then Exit Sub
        Tu = Replace(Replace(Tu, "/", "."), "-", ".")
        Den = Replace(Replace(Den, "/", "."), "-", ".")
fDate = DateSerial(Split(Tu, ".")(2), Split(Tu, ".")(1), Split(Tu, ".")(0))
tDate = DateSerial(Split(Den, ".")(2), Split(Den, ".")(1), Split(Den, ".")(0))
    Arr = Sheet11.Range("A3:Z" & Sheet11.Range("A65536").End(3).Row)
        For i = 1 To UBound(Arr, 1)
            If fDate <= DateSerial(Split(Arr(i, 8), ".")(2), Split(Arr(i, 8), ".")(1), Split(Arr(i, 8), ".")(0)) And tDate >= _
            DateSerial(Split(Arr(i, 8), ".")(2), Split(Arr(i, 8), ".")(1), Split(Arr(i, 8), ".")(0)) Then mOk = 1
            If Me.OptionButton1 = True And Arr(i, 12) = 0 Then mOk = mOk + 1
            If Me.OptionButton2 = True And Arr(i, 12) > 0 Then mOk = mOk + 1
            If Me.OptionButton3 = True Then mOk = mOk + 1
            If WorksheetFunction.Trim(Arr(i, 1)) = "" Then mOk = 0
            
    If mOk = 2 Then
        K = K + 1
        ReDim Preserve Res(1 To 9, 1 To K)
        Res(1, K) = K
        Res(2, K) = Arr(i, 1)
        Res(3, K) = IIf(Arr(i, 2) = "", Arr(i, 3), Arr(i, 2))
        Res(4, K) = Arr(i, 4)   'So the BHYT
        Res(5, K) = Arr(i, 8)   'Ngay kham
        Res(6, K) = IIf(Arr(i, 12) = 0, 0, Format(Arr(i, 12), "#,###"))
        Res(7, K) = IIf(Arr(i, 13) = 0, 0, Format(Arr(i, 13), "#,###"))
        Res(8, K) = Format(Arr(i, 18), "#,###")  'Tong cong
        Res(9, K) = Format(Arr(i, 22), "#,###")
        tongcong = tongcong + Arr(i, 22)
        End If
        
    Next i
            TextBox5 = Format(tongcong, "#,###")
            ListBox1.Width = 680.2: ListBox1.Height = 254.8
            Me.ListBox1.List = IIf(K < 2, Res, WorksheetFunction.Transpose(Res))
            Me.TextBox2.Value = K
'Dat lai tieu de Form va Tong cong
Me.Label11.Caption = "T" & ChrW(7893) & "ng b" & ChrW(7879) & "nh nh" & ChrW(226) & "n " & IIf(Me.OptionButton2 = True, _
"kh" & ChrW(225) & "m b" & ChrW(7879) & "nh", IIf(Me.OptionButton1 = True, "chuy" & ChrW(7875) & "n tuy" & ChrW(7871) & _
"n", "")) & " t" & ChrW(7915) & " ng" & ChrW(224) & "y " & Format(fDate, "dd/mm/yyyy") & " " & ChrW(273) & ChrW(7871) & _
"n ng" & ChrW(224) & "y " & Format(tDate, "dd/mm/yyyy") & ": "


Me.Label1.Caption = "B" & ChrW(7878) & "NH NH" & ChrW(194) & "N " & IIf(Me.OptionButton2 = True, "KH" & ChrW(193) & _
"M B" & ChrW(7878) & "NH", IIf(Me.OptionButton1 = True, "CHUY" & ChrW(7874) & "N TUY" & ChrW(7870) & "N", "")) & " T" & _
ChrW(7914) & " NG" & ChrW(192) & "Y " & Format(fDate, "DD/MM/YYYY") & " " & ChrW(272) & ChrW(7870) & "N NG" & ChrW(192) & _
"Y " & Format(tDate, "DD/MM/YYYY")


End Sub

Cảm ơn anh nhiều 1
Em đã test thử và đã OK

Hỏi cách đặt điều kiện trong OptionButon (1 người xem)

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

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên tiêu biểu

|||||||||||||

File đính kèm

|||||||||||||

Thành viên tiêu biểu

==(^o^)==

|||||||||||||

Thành viên tiêu biểu

==(^o^)==

Thành viên tiêu biểu

hello

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

File đính kèm

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên tiêu biểu

Đếm ngược thời gian