Kiểm tra việc nhập mã thẻ bhyt (1 người xem)

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

quoc nhat

Thành viên tiêu biểu
Tham gia
8/3/12
Bài viết
567
Được thích
43
Nghề nghiệp
cán bộ ngành y tế
Em xin nhờ mọi người giúp em đoạn code kiểm tra việc nhập mã thẻ BHYT nội dung như sau:
trong cell màu đỏ [D53] của "sheet 1" có cell nhập mã thẻ BHYT em muốn nhờ mọi người viết giúp đoạn code trong sự kiện Worksheet_Change() đoạn kiểm tra:
- Số ký tự đúng 15 ký tự thì bỏ qua còn nếu ít hơn hay nhiều hơn 15 ký tự thì hiện thông báo cảnh báo.
- Kiểm tra 2 ký tự đầu nếu trùng với một trong các mã ở cột B sheet DATA thì cho qua còn nếu khác thì hiện thông báo cảnh báo.
Rất mong được sự giúp đỡ của các anh chị.
Em cảm ơn!
 

File đính kèm

Lần chỉnh sửa cuối:
File của bạn khoá mã Password Project. Làm sao mà áp dụng vào File của bạn được.
 
Upvote 0
1. Chỉ cần dùng hàm len so sánh là được.
2. Có nhiều cách làm. Tuỳ theo số lượng mã mà có thể dùng find hoặc match.

Nếu nhập nhiều thì bài này cũng có thể là một thách thức đối với bạn nào muốn thử thách cách sử dụng phạm vi biến dictionary (gợi ý: biến tĩnh/static)
 
Upvote 0
1. Chỉ cần dùng hàm len so sánh là được.
2. Có nhiều cách làm. Tuỳ theo số lượng mã mà có thể dùng find hoặc match.

Nếu nhập nhiều thì bài này cũng có thể là một thách thức đối với bạn nào muốn thử thách cách sử dụng phạm vi biến dictionary (gợi ý: biến tĩnh/static)
Cảm ơn gợi ý của anh.
Nhưng em mù tịt về khoản VBA excel. mong ai ghé qua topic này giúp em một tay với đặc biệt là anh VetMini -\\/.
 
Upvote 0
Mình code thế này bạn bỏ vào File bạn áp dụng nhé!


PHP:
Sub CheckSoThe()
Dim rng As Range
Dim strChuoi As String
Dim result As String
strChuoi = Sheets("F1").Range("D53").Value
If Len(Trim(Range("D53").Value)) = 15 Then
    
    For Each rng In Sheets("F2").Range("B3:B36")
        If rng.Value = Left(strChuoi, 2) Then
            result = rng.Value
        End If
    
    Next rng
Else
    MsgBox "So the cua ban chua du 15 ky tu", vbInformation, "Nhap lai"

End If
If Left(strChuoi, 2) <> result Then MsgBox "Hai ky tu dau cua ban bi sau", vbOKCancel, "Nhap lai"

End Sub
 
Upvote 0
Mình code thế này bạn bỏ vào File bạn áp dụng nhé!


PHP:
Sub CheckSoThe()
Dim rng As Range
Dim strChuoi As String
Dim result As String
strChuoi = Sheets("F1").Range("D53").Value
If Len(Trim(Range("D53").Value)) = 15 Then
    
    For Each rng In Sheets("F2").Range("B3:B36")
        If rng.Value = Left(strChuoi, 2) Then
            result = rng.Value
        End If
    
    Next rng
Else
    MsgBox "So the cua ban chua du 15 ky tu", vbInformation, "Nhap lai"

End If
If Left(strChuoi, 2) <> result Then MsgBox "Hai ky tu dau cua ban bi sau", vbOKCancel, "Nhap lai"

End Sub
Em áp dụng vào file thấy được rồi anh
Cảm ơn anh nhiều
 
Upvote 0
Bạn quoc nhat có thể gửi cho mình xin file hoàn chỉnh bạn đang làm việc được không? Nếu được bạn gửi giúp vào mail haiphamkd@gmail.com dùm mình.
Cảm ơn!
 
Upvote 0
Có 1 số vấn đề cần thảo luận về macro trên nhân lúc rỗi, như sau:

(1) Macro đó nên sửa lại là vầy:
PHP:
Option Explicit
Sub CheckSoThe()
 Dim Rng As Range
 Dim StrChuoi As String, Result As String

 StrChuoi = Sheets("Sheet1").Range("D53").Value
4 If Len(Trim(Range("D53").Value)) = 15 Then    '??'
    For Each Rng In Sheets("DATA").Range("B3:B36")
        If Rng.Value = UCase$(Left(StrChuoi, 2)) Then
            MsgBox "OK", , "Xin Chúc Mùng!"
7            Exit Sub
        End If
    Next Rng
 Else
    MsgBox "So the cua ban chua du 15 ky tu", vbInformation, "Nhap lai"
12    Exit Sub
 End If
 MsgBox "Hai Kí Tu Dàu Cua Ban Bi Sai", vbOKCancel, "Nhap lai"
End Sub

Lí do:
(*) Khi tìm thấy 2 chữ cái đầu đã trùng thì không cần duyệt tiếp trong vòng lặp nữa; Ta nên thoát ngay nhờ dòng lệnh mang số 7 để tiết kiệm thời gian cho mình & năng lượng điện cho máy.

(*) Bạn suy nghĩ xem dòng lệnh mang số 12 có lợi gì cho bạn?

Nhưng dù sao, macro còn tiềm ẩn sai sót rất lớn ở dòng lệnh số 4; Vì tác giả lại xài hàm TRIM() không cần thiết!

Nếu là mình thì mình viết macro đó có nội dung như sau:

PHP:
Sub KiemTraMaBHYT()
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 Dim sMa As String
 
 Sheets("Sheet1").Select
 sMa = Range("D53").Value
 If Len(sMa) <> 15 Then
    MsgBox "Só The Ban Nhap Chua Chuan", vbInformation, "Nhap lai & Can Than Hon!"
 Else
    Set Sh = ThisWorkbook.Worksheets("DATA")
    Set Rng = Sh.Range(Sh.[B2], Sh.[B2].End(xlDown))
    Set sRng = Rng.Find(Left(sMa, 2), , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        MsgBox "Hai Kí Tu Dàu Cua Ban Bi Sai", vbOKCancel, "Nhap lai"
    Else
        MsgBox "OK", , "Xin Chúc Mùng!"
    End If
 End If
End Sub

(húc mừng xuân mới!
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn anh SA-DQ!
Em sẽ xem lại
Chúc mừng năm mới!
 
Upvote 0

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

Back
Top Bottom