Bẫy lỗi nhập trùng dữ liệu trong phạm vi cột chỉ định thì hiện hộp thoại thông báo (1 người xem)

  • Thread starter Thread starter van80
  • Ngày gửi Ngày gửi
Liên hệ QC

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

van80

Thành viên chính thức
Tham gia
5/7/09
Bài viết
73
Được thích
4
Chào các anh, chị trên diễn đàn !
Nhờ anh, chị viết dùm code trong vba nhập trùng dữ liệu thì hiện hộp thoại thông báo.
Nội dung yêu cầu tôi đã trình bày rõ trong filemau đính kèm.
Xin trích dẫn như sau:
Bẫy lỗi nhập trùng dữ liệu trong phạm vi cột chỉ định:
- Phạm vi 1 là cột E
- Phạm vi 2 là cột F:O
- Phạm vi 1 không liên quan gì đến phạm vi 2
- Cột A,B,C và D không liên quan gì đến phạm vi 1 và 2
Tập tin đính kèm:
View attachment filemau.xls
Trân trọng cảm ơn ! Thân chào !
 
Chào các anh, chị trên diễn đàn !
Nhờ anh, chị viết dùm code trong vba nhập trùng dữ liệu thì hiện hộp thoại thông báo.
Nội dung yêu cầu tôi đã trình bày rõ trong filemau đính kèm.
Xin trích dẫn như sau:
Bẫy lỗi nhập trùng dữ liệu trong phạm vi cột chỉ định:
- Phạm vi 1 là cột E
- Phạm vi 2 là cột F:O
- Phạm vi 1 không liên quan gì đến phạm vi 2
- Cột A,B,C và D không liên quan gì đến phạm vi 1 và 2
Tập tin đính kèm:
View attachment 103119
Trân trọng cảm ơn ! Thân chào !
Bài này chẳng cần đến VBA, chỉ cần Data Validation là đủ.
1. Chọn vùng E4:E20 (ô hiện hành: E4) và thiết lập Validation với công thức:
Mã:
=COUNTIF($E$4:$E$20,E4)=1
2. Chọn vùng F4:O20 (ô hiện hành: F4) và thiết lập Validation với công thức:
Mã:
=COUNTIF($F$4:$O$20,F4)=1
Bây giờ, bạn xóa dữ liệu 2 vùng này và nhập lại thử xem sao.
 

File đính kèm

Upvote 0
Bài này chẳng cần đến VBA, chỉ cần Data Validation là đủ.
1. Chọn vùng E4:E20 (ô hiện hành: E4) và thiết lập Validation với công thức:
Mã:
=COUNTIF($E$4:$E$20,E4)=1
2. Chọn vùng F4:O20 (ô hiện hành: F4) và thiết lập Validation với công thức:
Mã:
=COUNTIF($F$4:$O$20,F4)=1
Bây giờ, bạn xóa dữ liệu 2 vùng này và nhập lại thử xem sao.
cám ơn bạn nghiaphuc !
thiết lập công thức như bạn mình biết rồi. yêu cầu của mình là code vba chứ không phải là công thức.
mình cần code vba, bỡi vì code vba mới có tác dụng trong chương trình của mình.
 
Lần chỉnh sửa cuối:
Upvote 0
Thì đây, mời bạn xơi thử:

[ThongBao]cám ơn bạn!
Yêu cầu của mình là code vba chứ không phải là công thức.
(/ì code vba mới có tác dụng trong chương trình của mình.[/Thongbao]

PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range
 
 If Not Intersect(Target, Columns("E:E")) Is Nothing Then
    Set Rng = Columns("E:E")
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MsgBox sRng.Address, , "Trùng Ròi Ban!"
    End If
 ElseIf Not Intersect(Target, Columns("E:O")) Is Nothing Then
    Set Rng = Columns("F:O")
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MsgBox "Trùng Ròi Ban!", , sRng.Address
    End If
 End If
End Sub

Chúc vui nha! --=0 }}}}} --=0
 
Upvote 0
anh ChanhTQ ơi, nó báo trùng với cell mình gõ vào
vd ở cell E4 gõ "001" nó báo trùng với cell E4 (tức là nó)
 
Upvote 0
anh ChanhTQ ơi, nó báo trùng với cell mình gõ vào
vd ở cell E4 gõ "001" nó báo trùng với cell E4 (tức là nó)
Vậy thì thay vì điều kiện Not sRng Is Nothing (điều kiện này luôn đúng vì luôn tìm thấy ít nhất 1 giá trị vừa nhập vào), ta dùng điều kiện sRng.Address <> Target.Address.
Thêm nữa, trong phương thức Find, thay vì tìm trong công thức (xlFormulas), ta nên tìm trong giá trị (xlValues) thì phù hợp hơn.
 
Upvote 0
[ThongBao]cám ơn bạn!
Yêu cầu của mình là code vba chứ không phải là công thức.
(/ì code vba mới có tác dụng trong chương trình của mình.[/ThongBao]

PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range
 
 If Not Intersect(Target, Columns("E:E")) Is Nothing Then
    Set Rng = Columns("E:E")
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MsgBox sRng.Address, , "Trùng Ròi Ban!"
    End If
 ElseIf Not Intersect(Target, Columns("E:O")) Is Nothing Then
    Set Rng = Columns("F:O")
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MsgBox "Trùng Ròi Ban!", , sRng.Address
    End If
 End If
End Sub

Chúc vui nha! --=0 }}}}} --=0
Cám ơn bạn ChanhTQ !
Bạn ChanhTQ ơi, nó báo trùng với cell mình gõ vào
vd ở cell E4 gõ "001" nó báo trùng với cell E4 (tức là nó)
Bây giờ phải làm sao đây. Bạn viết dùm lại code nhé!
Nếu nhập dữ liệu vào trùng thì hiệm hộp thoại thông báo, ta click lệnh OK thì xóa luôn dữ liệu trùng vừa nhập vào.
Thân chào Bạn !
 
Upvote 0
Cám ơn bạn ChanhTQ !
Bạn ChanhTQ ơi, nó báo trùng với cell mình gõ vào
vd ở cell E4 gõ "001" nó báo trùng với cell E4 (tức là nó)
Bây giờ phải làm sao đây. Bạn viết dùm lại code nhé!
Nếu nhập dữ liệu vào trùng thì hiệm hộp thoại thông báo, ta click lệnh OK thì xóa luôn dữ liệu trùng vừa nhập vào.
Thân chào Bạn !
Thế bạn đã đọc bài của tôi vừa viết ở trên không. Đó chính là câu trả lời cho câu hỏi của bạn đấy.
Còn việc xóa dữ liệu vừa nhập vào thì bạn thêm 2 câu lệnh này vào sau câu lệnh Msgbox...:
PHP:
Target.ClearContents: Target.Select
 
Upvote 0
Thế bạn đã đọc bài của tôi vừa viết ở trên không. Đó chính là câu trả lời cho câu hỏi của bạn đấy.
Còn việc xóa dữ liệu vừa nhập vào thì bạn thêm 2 câu lệnh này vào sau câu lệnh Msgbox...:
PHP:
Target.ClearContents: Target.Select
Cám ơn bạn nghiaphuc !
mình thêm vào rồi. Đoạn lệnh thứ nhất thì chạy tốt. còn đoạn lệnh thứ 2
ElseIf Not Intersect(Target, Columns("E:O")) Is Nothing Then
Set Rng = Columns("F:O")
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If sRng.Address <> Target.Address Then
MsgBox "Trùng Ròi Ban!", , sRng.Address
Target.ClearContents: Target.Select
End If
bị lỗi bạn ơi khi ta click lệnh ok thì treo máy luôn, Bạn xem lại dùm mình nha !
 
Upvote 0
Cám ơn bạn nghiaphuc !
mình thêm vào rồi. Đoạn lệnh thứ nhất thì chạy tốt. còn đoạn lệnh thứ 2
ElseIf Not Intersect(Target, Columns("E:O")) Is Nothing Then
Set Rng = Columns("F:O")
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If sRng.Address <> Target.Address Then
MsgBox "Trùng Ròi Ban!", , sRng.Address
Target.ClearContents: Target.Select
End If
bị lỗi bạn ơi khi ta click lệnh ok thì treo máy luôn, Bạn xem lại dùm mình nha !

Bạn thử xem

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tim As Range
On Error GoTo errhandler:
Application.EnableEvents = False

If Not Intersect(Target, [C4:C10000]) Is Nothing Then
Set tim = [c4:c1000].Find(Target.Value)
If tim.Address <> Target.Address Then
MsgBox "Trung voi cell " & tim.Address
Target.ClearContents
End If
ElseIf Not Intersect(Target, [f4:o10000]) Is Nothing Then
Set tim = [f4:o1000].Find(Target.Value)
If tim.Address <> Target.Address Then
MsgBox "Trung voi cell " & tim.Address
Target.ClearContents
End If
End If

Set tim = Nothing
errhandler:
Application.EnableEvents = True
End Sub
 
Upvote 0
Bạn thử xem

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tim As Range
On Error GoTo errhandler:
Application.EnableEvents = False

If Not Intersect(Target, [C4:C10000]) Is Nothing Then
Set tim = [c4:c1000].Find(Target.Value)
If tim.Address <> Target.Address Then
MsgBox "Trung voi cell " & tim.Address
Target.ClearContents
End If
ElseIf Not Intersect(Target, [f4:o10000]) Is Nothing Then
Set tim = [f4:o1000].Find(Target.Value)
If tim.Address <> Target.Address Then
MsgBox "Trung voi cell " & tim.Address
Target.ClearContents
End If
End If

Set tim = Nothing
errhandler:
Application.EnableEvents = True
End Sub
Cám ơn bạn nhapmon ! Rất tuyệt vời !
Nhưng bạn ơi, ở dữ liệu trắng ta bắt đầu nhập dữ liệu 1 đến dữ liệu 3 mới thông báo trùng.
Ví dụ : 001, 001, 001 thì mới thông báo trùng. Bạn xem lại code dùm mình nha !
Khi ta nhập 001, 001 thì chương trình phải thông báo trùng . thân chào bạn 1
 
Lần chỉnh sửa cuối:
Upvote 0
cái nào số 4, bạn sử lại thành 3 dủm
E4:E10000 sửa thành E3:E1000, mình cũng chẳng hiểu tại sao nữa....................--=0
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn bạn nhapmon ! Rất tuyệt vời !
Nhưng bạn ơi, ở dữ liệu trắng ta bắt đầu nhập dữ liệu 1 đến dữ liệu 3 mới thông báo trùng.
Ví dụ : 001, 001, 001 thì mới thông báo trùng. Bạn xem lại code dùm mình nha !
Khi ta nhập 001, 001 thì chương trình phải thông báo trùng . thân chào bạn 1
Sửa lại code của bác ChanhTQ@ một chút xem sao:
[GPECODE=vb]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range

If Target.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, [E4:E65000]) Is Nothing Then
Set Rng = [E4:E65000].Find(Format(Target, "000"), Target, xlValues, xlWhole)
If Rng.Address <> Target.Address Then
MsgBox "Trung voi cell " & Rng.Address: Target.ClearContents: Target.Select
End If
ElseIf Not Intersect(Target, [F4:O65000]) Is Nothing Then
Set Rng = [F4:O65000].Find(Format(Target, "0000000"), Target, xlValues, xlWhole)
If Rng.Address <> Target.Address Then
MsgBox "Trung voi cell " & Rng.Address: Target.ClearContents: Target.Select
End If
End If
Application.EnableEvents = True
End Sub[/GPECODE]
 
Upvote 0
Sửa lại code của bác ChanhTQ@ một chút xem sao:
[GPECODE=vb]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range

If Target.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, [E4:E65000]) Is Nothing Then
Set Rng = [E4:E65000].Find(Format(Target, "000"), Target, xlValues, xlWhole)
If Rng.Address <> Target.Address Then
MsgBox "Trung voi cell " & Rng.Address: Target.ClearContents: Target.Select
End If
ElseIf Not Intersect(Target, [F4:O65000]) Is Nothing Then
Set Rng = [F4:O65000].Find(Format(Target, "0000000"), Target, xlValues, xlWhole)
If Rng.Address <> Target.Address Then
MsgBox "Trung voi cell " & Rng.Address: Target.ClearContents: Target.Select
End If
End If
Application.EnableEvents = True
End Sub[/GPECODE]
Cám ơn bạn nghiaphuc !
Đoạn code của bạn chạy rất tốt. Mình còn nhiều vấn đề để hỏi các bạn nữa. Mong các bạn giúp đỡ nha!
Có 1 vấn đề này mà mình nghĩ không ra nhờ các bạn giúp dùm.
Nhập bằng " tay " thì thông báo lỗi dữ liệu nhập trùng còn nhập bằng nút lệnh do mình tự viết code thi không báo lỗi dữ liệu nhập trùng. Nguyên nhân là tại sao ?
File đính kèm : View attachment filemau1.xls
Thân chào các bạn !
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn bạn nghiaphuc !
Đoạn code của bạn chạy rất tốt. Mình còn nhiều vấn đề để hỏi các bạn nữa. Mong các bạn giúp đỡ nha!
Có 1 vấn đề này mà mình nghĩ không ra nhờ các bạn giúp dùm.
Nhập bằng " tay " thì thông báo lỗi dữ liệu nhập trùng còn nhập bằng nút lệnh do mình tự viết code thi không báo lỗi dữ liệu nhập trùng. Nguyên nhân là tại sao ?
File đính kèm : View attachment 103208
Thân chào các bạn !
Nguyên nhân là ở câu lệnh này:
PHP:
If Target.Count > 1 Then Exit Sub
Code của bạn copy cả một vùng dán qua bên phải nên điều kiện Target.Count > 1 được thỏa mãn, do đó lệnh Exit Sub được thực hiện. Kết quả là Code chẳng kiểm tra cái gì cả.
Bạn sửa code lại như sau là được:
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Cll As Range

Application.EnableEvents = False
For Each Cll In Target
If Not IsEmpty(Cll) Then
If Not Intersect(Cll, [E4:E65000]) Is Nothing Then
Set Rng = [E4:E65000].Find(Format(Cll, "000"), Cll, xlValues, xlWhole)
If Rng.Address <> Cll.Address Then
MsgBox "Trung voi cell " & Rng.Address: Cll.ClearContents: Cll.Select
End If
ElseIf Not Intersect(Cll, [F4:O65000]) Is Nothing Then
Set Rng = [F4:O65000].Find(Format(Cll, "0000000"), Cll, xlValues, xlWhole)
If Rng.Address <> Cll.Address Then
MsgBox "Trung voi cell " & Rng.Address: Cll.ClearContents: Cll.Select
End If
End If
End If
Next
Application.EnableEvents = True
End Sub[/GPECODE]
Ngoài ra, code cho nút lệnh của bạn nên làm thế này cho gọn và phù hợp hơn:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range
With Sheets("DATA")
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
 
Lần chỉnh sửa cuối:
Upvote 0
Nguyên nhân là ở câu lệnh này:
PHP:
If Target.Count > 1 Then Exit Sub
Code của bạn copy cả một vùng dán qua bên phải nên điều kiện Target.Count > 1 được thỏa mãn, do đó lệnh Exit Sub được thực hiện. Kết quả là Code chẳng kiểm tra cái gì cả.
Bạn sửa code lại như sau là được:
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Cll As Range

Application.EnableEvents = False
For Each Cll In Target
If Not IsEmpty(Cll) Then
If Not Intersect(Cll, [E4:E65000]) Is Nothing Then
Set Rng = [E4:E65000].Find(Format(Cll, "000"), Cll, xlValues, xlWhole)
If Rng.Address <> Cll.Address Then
MsgBox "Trung voi cell " & Rng.Address: Cll.ClearContents: Cll.Select
End If
ElseIf Not Intersect(Cll, [F4:O65000]) Is Nothing Then
Set Rng = [F4:O65000].Find(Format(Cll, "0000000"), Cll, xlValues, xlWhole)
If Rng.Address <> Cll.Address Then
MsgBox "Trung voi cell " & Rng.Address: Cll.ClearContents: Cll.Select
End If
End If
End If
Next
Application.EnableEvents = True
End Sub[/GPECODE]
Ngoài ra, code cho nút lệnh của bạn nên làm thế này cho gọn và phù hợp hơn:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range
With Sheets("DATA")
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
Cám ơn bạn nghiaphuc rất nhiều ! Đoạn code của bạn chạy rất tuyệt vời.
Nhân tiện đây bạn giúp dùm mình một vấn đề nữa nha!
Nếu Số hộ trùng và ta Click lệnh OK thì các mã thuộc số hộ này phải dừng lại không nhập vào, chờ đến khi ta gõ lại số hộ thì mới thực hiện.
Thân chào bạn !
 
Upvote 0
Cám ơn bạn nghiaphuc rất nhiều ! Đoạn code của bạn chạy rất tuyệt vời.
Nhân tiện đây bạn giúp dùm mình một vấn đề nữa nha!
Nếu Số hộ trùng và ta Click lệnh OK thì các mã thuộc số hộ này phải dừng lại không nhập vào, chờ đến khi ta gõ lại số hộ thì mới thực hiện.
Thân chào bạn !
Vậy thì làm thêm 1 bẫy lỗi nữa, nếu tìm thấy số hộ vừa nhập đã có trên cột E thì hiện thông báo, xóa số vừa nhập và dừng lại, nếu chưa tồn tại thì mới nhập giá trị vào vùng bên phải:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range
With Sheets("DATA")
Set Rng = .[E4:E65000].Find(Format(.[C4], "000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "So ho nay da ton tai. Hay nhap lai so khac!"
.[C4:C13].ClearContents: .[C4].Select
Exit Sub
End If
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
 
Upvote 0
Vậy thì làm thêm 1 bẫy lỗi nữa, nếu tìm thấy số hộ vừa nhập đã có trên cột E thì hiện thông báo, xóa số vừa nhập và dừng lại, nếu chưa tồn tại thì mới nhập giá trị vào vùng bên phải:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range
With Sheets("DATA")
Set Rng = .[E4:E65000].Find(Format(.[C4], "000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "So ho nay da ton tai. Hay nhap lai so khac!"
.[C4:C13].ClearContents: .[C4].Select
Exit Sub
End If
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
Cám ơn Bạn nghiaphuc rất nhiều ! đoạn code của bạn rất hay.
Trong quá trình nhập liệu nếu có vấn đề gì phát sinh mình sẽ hỏi tiếp nha!
Thân mến chào bạn !
 
Upvote 0
Cám ơn Bạn nghiaphuc rất nhiều ! đoạn code của bạn rất hay.
Trong quá trình nhập liệu nếu có vấn đề gì phát sinh mình sẽ hỏi tiếp nha!
Thân mến chào bạn !
Bạn nghiaphuc ơi ! trong quá trình nhập liệu lại phát sinh vấn đề mới nữa rồi.
Vấn đề ngược lại: Nếu số hộ là đúng mà số mã bị trùng khi ta Click Ok thì lần lượt xóa các mã bị trùng điều này là đúng. Nhưng khi gõ lại các mã bị trùng và ta Click nút lệnh Nhap Moi thì báo số hộ bị trùng. Mình phải xóa số hộ vừa báo trùng bằng "tay" thì mới cho nhập. Điều này bất tiện quá bạn ơi ! Bạn giải quyết dùm mình ở điểm này nha.
Thân chào bạn !
 
Upvote 0
Bạn nghiaphuc ơi ! trong quá trình nhập liệu lại phát sinh vấn đề mới nữa rồi.
Vấn đề ngược lại: Nếu số hộ là đúng mà số mã bị trùng khi ta Click Ok thì lần lượt xóa các mã bị trùng điều này là đúng. Nhưng khi gõ lại các mã bị trùng và ta Click nút lệnh Nhap Moi thì báo số hộ bị trùng. Mình phải xóa số hộ vừa báo trùng bằng "tay" thì mới cho nhập. Điều này bất tiện quá bạn ơi ! Bạn giải quyết dùm mình ở điểm này nha.
Thân chào bạn !
Thôi thì bỏ hẳn cách nhập thủ công vào vùng bên phải nhé. Bạn xóa Sub Worksheet_Change đi hoặc đổi tên nó để khỏi có tác dụng.

Code cho nút lệnh bây giờ là thế này:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range, Cll As Range
With Sheets("DATA")
'Kiem tra So ho
If IsEmpty(.[C4]) Then
MsgBox "Chua nhap So ho!": .[C4].Select: Exit Sub
Else
Set Rng = .[E4:E65000].Find(Format(.[C4], "000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "So ho nay da ton tai. Hay nhap lai so khac!"
.[C4:C13].ClearContents: .[C4].Select: Exit Sub
End If
End If
'Kiem tra Ma so
If .[B14].End(xlUp).Row = 3 Then
MsgBox "Chua nhap Ma so nao!": .[B4].Select: Exit Sub
Else
For Each Cll In .[B4:B13]
If Not IsEmpty(Cll) Then
Set Rng = .[F4:O65000].Find(Format(Cll, "0000000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "Ma so " & Format(Cll, "0000000") & " da ton tai. Hay nhap lai ma so khac!"
Cll.ClearContents: Cll.Select: Exit Sub
End If
End If
Next
End If
'Da kiem tra xong, du lieu hop le --> Nhap gia tri qua vung ben phai
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
 
Upvote 0
Thôi thì bỏ hẳn cách nhập thủ công vào vùng bên phải nhé. Bạn xóa Sub Worksheet_Change đi hoặc đổi tên nó để khỏi có tác dụng.

Code cho nút lệnh bây giờ là thế này:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range, Cll As Range
With Sheets("DATA")
'Kiem tra So ho
If IsEmpty(.[C4]) Then
MsgBox "Chua nhap So ho!": .[C4].Select: Exit Sub
Else
Set Rng = .[E4:E65000].Find(Format(.[C4], "000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "So ho nay da ton tai. Hay nhap lai so khac!"
.[C4:C13].ClearContents: .[C4].Select: Exit Sub
End If
End If
'Kiem tra Ma so
If .[B14].End(xlUp).Row = 3 Then
MsgBox "Chua nhap Ma so nao!": .[B4].Select: Exit Sub
Else
For Each Cll In .[B4:B13]
If Not IsEmpty(Cll) Then
Set Rng = .[F4:O65000].Find(Format(Cll, "0000000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "Ma so " & Format(Cll, "0000000") & " da ton tai. Hay nhap lai ma so khac!"
Cll.ClearContents: Cll.Select: Exit Sub
End If
End If
Next
End If
'Da kiem tra xong, du lieu hop le --> Nhap gia tri qua vung ben phai
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
Cám ơn bạn rất nhiều ! Quá tuyệt vời !
Mình còn nhiều vấn hỏi bạn, bạn giúp mình nha !
"Chúc Bạn hạnh phúc anh lành
Tương lai tưoi đẹp tràn đầy niềm vui "
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn bạn rất nhiều ! Quá tuyệt vời !
Mình còn nhiều vấn hỏi bạn, bạn giúp mình nha !
"Chúc Bạn hạnh phúc anh lành
Tương lai tưoi đẹp tràn đầy niềm vui "
Trong quá trình nhập liệu lại phát sinh một bẫy lỗi mới nữa.
Tất cả bẫy lỗi của bạn viết vừa rồi là quá tuyệt vời. Nhưng vẫn còn một lỗi rất lớn đó là :
Ví dụ: Số hộ và các mã cũa số hộ đều không trùng với dữ liệu đã nhập, nhưng các mã của số hộ đều cùng một mã ví dụ như số hộ là 001, các mã la 0101001, 0101001, 0101001 Click OK thì vùng nhập liệu bên phải các mã bị trùng.
thì không thấy hiện hộp thoại thông báo. Ta có nên kết hợp 2 phương thức hay không ? Private Sub CommandButton1_Click() và Sub Worksheet_Change.
Bạn giúp mình giải quyết vấn đề này đi.
Thân chào bạn !
 
Lần chỉnh sửa cuối:
Upvote 0
Trong quá trình nhập liệu lại phát sinh một bẫy lỗi mới nữa.
Tất cả bẫy lỗi của bạn viết vừa rồi là quá tuyệt vời. Nhưng vẫn còn một lỗi rất lớn đó là :
Ví dụ: Số hộ và các mã cũa số hộ đều không trùng với dữ liệu đã nhập, nhưng các mã của số hộ đều cùng một mã ví dụ như số hộ là 001, các mã la 0101001, 0101001, 0101001 Click OK thì vùng nhập liệu bên phải các mã bị trùng.
thì không thấy hiện hộp thoại thông báo. Ta có nên kết hợp 2 phương thức hay không ? PrivateSubCommandButton1_Click() và Sub Worksheet_Change.
Bạn giúp mình giải quyết vấn đề này đi.
Thân chào bạn !
Nếu nhập bằng code thì không sử dụng sự kiện Worksheet_Change nữa. Vấn đề là sửa code CommandButton1_Click thế nào cho phù hợp thôi.
Bây giờ, thay vì kiểm tra mã số chỉ trong vùng F4:O65000 thì mình tìm thêm trong vùng B4:B13 nữa, như vậy là kiểm soát được vấn đề mã nhập thủ công ở bên trái có sự trùng lặp.
Code bây giờ là thế này:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range, Cll As Range
With Sheets("DATA")
'Kiem tra So ho
If IsEmpty(.[C4]) Then
MsgBox "Chua nhap So ho!": .[C4].Select: Exit Sub
Else
Set Rng = .[E4:E65000].Find(Format(.[C4], "000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "So ho nay da ton tai. Hay nhap lai so khac!"
.[C4:C13].ClearContents: .[C4].Select: Exit Sub
End If
End If
'Kiem tra Ma so
If .[B14].End(xlUp).Row = 3 Then
MsgBox "Chua nhap Ma so nao!": .[B4].Select: Exit Sub
Else
For Each Cll In .[B4:B13]
If Not IsEmpty(Cll) Then
Set Rng = .[B4:B13,F4:O65000].Find(Format(Cll, "0000000"), Cll, xlValues, xlWhole) 'Cho nay moi sua lai
If Rng.Address <> Cll.Address Then 'Cho nay moi sua lai
MsgBox "Ma so " & Format(Cll, "0000000") & " bi trung. Hay nhap lai ma so khac!"
Cll.ClearContents: Cll.Select: Exit Sub
End If
End If
Next
End If
'Da kiem tra xong, du lieu hop le --> Nhap gia tri qua vung ben phai
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
 
Upvote 0
Nếu nhập bằng code thì không sử dụng sự kiện Worksheet_Change nữa. Vấn đề là sửa code CommandButton1_Click thế nào cho phù hợp thôi.
Bây giờ, thay vì kiểm tra mã số chỉ trong vùng F4:O65000 thì mình tìm thêm trong vùng B4:B13 nữa, như vậy là kiểm soát được vấn đề mã nhập thủ công ở bên trái có sự trùng lặp.
Code bây giờ là thế này:
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim Rng As Range, Cll As Range
With Sheets("DATA")
'Kiem tra So ho
If IsEmpty(.[C4]) Then
MsgBox "Chua nhap So ho!": .[C4].Select: Exit Sub
Else
Set Rng = .[E4:E65000].Find(Format(.[C4], "000"), , xlValues, xlWhole)
If Not Rng Is Nothing Then
MsgBox "So ho nay da ton tai. Hay nhap lai so khac!"
.[C4:C13].ClearContents: .[C4].Select: Exit Sub
End If
End If
'Kiem tra Ma so
If .[B14].End(xlUp).Row = 3 Then
MsgBox "Chua nhap Ma so nao!": .[B4].Select: Exit Sub
Else
For Each Cll In .[B4:B13]
If Not IsEmpty(Cll) Then
Set Rng = .[B4:B13,F4:O65000].Find(Format(Cll, "0000000"), Cll, xlValues, xlWhole) 'Cho nay moi sua lai
If Rng.Address <> Cll.Address Then 'Cho nay moi sua lai
MsgBox "Ma so " & Format(Cll, "0000000") & " bi trung. Hay nhap lai ma so khac!"
Cll.ClearContents: Cll.Select: Exit Sub
End If
End If
Next
End If
'Da kiem tra xong, du lieu hop le --> Nhap gia tri qua vung ben phai
Set Rng = .[E65000].End(xlUp).Offset(1)
Rng = .[C4]: Rng.NumberFormat = "000"
Rng.Offset(, 1).Resize(, 10) = WorksheetFunction.Transpose(.[B4:B13])
Rng.Offset(, 1).Resize(, 10).NumberFormat = "0000000"
End With
End Sub[/GPECODE]
Cám ơn bạn rất nhiều !
Bài toán bẫy lỗi đến đây xem như đã hoàn thiện.
"Chúc Bạn hạnh phúc anh lành
Tương lai tưoi đẹp tràn đầy niềm vui "

Thân mến chào bạn !
 
Upvote 0
Cám ơn bạn rất nhiều !
Bài toán bẫy lỗi đến đây xem như đã hoàn thiện.
"Chúc Bạn hạnh phúc anh lành
Tương lai tưoi đẹp tràn đầy niềm vui "

Thân mến chào bạn !
Bạn nghiaphuc ơi !
Trong quá trình nhập liệu, mình vô tình gõ số hộ hay các mã số của số hộ là kí tự chữ ví dụ: số hộ là k01, 02k, k, ... và các mã là 010k001, 010200k, ... Thì không đúng theo yêu cầu nhập liệu rồi. Trong vùng nhập liệu của mình phải là kí tự số ví dụ : 001, 002, .... 0101001, 0206003, ...
Bạn giải quyết dùm mình vấn đề này " bẫy lỗi kí tự số " nha !
Khi Click Nhập Moi nếu các mã hay số hộ không phải là 001, 002, .... ; 0101001, 0206003, ... thì thông báo lỗi
Thân mến chào bạn !
 
Upvote 0
Bạn nghiaphuc ơi !
Trong quá trình nhập liệu, mình vô tình gõ số hộ hay các mã số của số hộ là kí tự chữ ví dụ: số hộ là k01, 02k, k, ... và các mã là 010k001, 010200k, ... Thì không đúng theo yêu cầu nhập liệu rồi. Trong vùng nhập liệu của mình phải là kí tự số ví dụ : 001, 002, .... 0101001, 0206003, ...
Bạn giải quyết dùm mình vấn đề này " bẫy lỗi kí tự số " nha !
Khi Click Nhập Moi nếu các mã hay số hộ không phải là 001, 002, .... ; 0101001, 0206003, ... thì thông báo lỗi
Thân mến chào bạn !
Các bạn giúp dùm mình bài #25 nha!
Cám ơn các bạn nhiều !
 
Upvote 0
Bạn thử xem

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tim As Range
On Error GoTo errhandler:
Application.EnableEvents = False

If Not Intersect(Target, [C4:C10000]) Is Nothing Then
Set tim = [c4:c1000].Find(Target.Value)
If tim.Address <> Target.Address Then
MsgBox "Trung voi cell " & tim.Address
Target.ClearContents
End If
ElseIf Not Intersect(Target, [f4:eek:10000]) Is Nothing Then
Set tim = [f4:eek:1000].Find(Target.Value)
If tim.Address <> Target.Address Then
MsgBox "Trung voi cell " & tim.Address
Target.ClearContents
End If
End If

Set tim = Nothing
errhandler:
Application.EnableEvents = True
End Sub
Bác có thể chỉnh code giúp em nếu dữ liệu là chữ được không ạ, em dùng code này nếu chỉ có 1 chữ giống nhau nó cũng báo lỗi (ví dụ giấy decan với giấy decan màu vàng là 2 loại khác nhau nhưng nó vẫn báo lỗi trùng ạ)
 
Upvote 0
mình có 1 file đơn giản như thế này. bạn nào có thể giúp mình 1 code cho trường hợp 1 ngày nhập 2 lần sẽ có MsgBox thông báo là nhập trùng không ạ. cảm ơn mọi người
 

File đính kèm

Upvote 0
1 ngày nhập cái gì 2 lần bạn? 1 mã số NV chỉ nhập 1 lần/1 ngày hay gì, bạn nêu rõ ra nhé.
 
Upvote 0
mình có 1 file đơn giản như thế này. bạn nào có thể giúp mình 1 code cho trường hợp 1 ngày nhập 2 lần sẽ có MsgBox thông báo là nhập trùng không ạ. cảm ơn mọi người
Dán code sau vào trong trang code của sheet Data:
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, tRw&, sKey$
    If Target.Row >= 3 And Target.Column = 3 Then
        tRw = Target.Row
        If Range("A" & tRw) <> "" And Range("C" & tRw) <> "" Then
            sKey = Range("A" & tRw) & "-" & Range("C" & tRw)
            For i = 3 To tRw - 1
                If Range("A" & i) & "-" & Range("C" & i) = sKey Then MsgBox "Trùng!"
                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True
                Exit For
            Next
        End If
    End If
End Sub

Khi nhập ngày (cột C) xong mà phát hiện cả hai cột mã số và ngày trùng với bất kỳ dòng nào phía bên trên dòng hiện tại thì xóa ngày vừa nhập, nổi thông báo.
 
Upvote 0
1 ngày nhập cái gì 2 lần bạn? 1 mã số NV chỉ nhập 1 lần/1 ngày hay gì, bạn nêu rõ ra nhé.
À là ngày và MSNV chỉ nhập 1 lần ấy ạ. thank bạn
Bài đã được tự động gộp:

Dán code sau vào trong trang code của sheet Data:
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, tRw&, sKey$
    If Target.Row >= 3 And Target.Column = 3 Then
        tRw = Target.Row
        If Range("A" & tRw) <> "" And Range("C" & tRw) <> "" Then
            sKey = Range("A" & tRw) & "-" & Range("C" & tRw)
            For i = 3 To tRw - 1
                If Range("A" & i) & "-" & Range("C" & i) = sKey Then MsgBox "Trùng!"
                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True
                Exit For
            Next
        End If
    End If
End Sub

Khi nhập ngày (cột C) xong mà phát hiện cả hai cột mã số và ngày trùng với bất kỳ dòng nào phía bên trên dòng hiện tại thì xóa ngày vừa nhập, nổi thông báo.
hi Bạn. mình đã làm theo nhưng khi nhập dữ liệu thì ko hiện mục Ngày cho dù là không nhập trùng
 
Lần chỉnh sửa cuối:
Upvote 0
hi Bạn. mình đã làm theo nhưng khi nhập dữ liệu thì ko hiện mục Ngày cho dù là không nhập trùng
À, tôi nhầm. Bạn thay bằng code này:
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, tRw&, sKey$
    If Target.Row >= 3 And Target.Column = 3 Then
        tRw = Target.Row
        If Range("A" & tRw) <> "" And Range("C" & tRw) <> "" Then
            sKey = Range("A" & tRw) & "-" & Range("C" & tRw)
            For i = 3 To tRw - 1
                If Range("A" & i) & "-" & Range("C" & i) = sKey Then
                    Application.EnableEvents = False
                    Target.Value = ""
                    Application.EnableEvents = True
                    MsgBox "Trùng dòng " & i
                    Exit For
                End If
            Next
        End If
    End If
End Sub
 
Upvote 0
À, tôi nhầm. Bạn thay bằng code này:
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, tRw&, sKey$
    If Target.Row >= 3 And Target.Column = 3 Then
        tRw = Target.Row
        If Range("A" & tRw) <> "" And Range("C" & tRw) <> "" Then
            sKey = Range("A" & tRw) & "-" & Range("C" & tRw)
            For i = 3 To tRw - 1
                If Range("A" & i) & "-" & Range("C" & i) = sKey Then
                    Application.EnableEvents = False
                    Target.Value = ""
                    Application.EnableEvents = True
                    MsgBox "Trùng dòng " & i
                    Exit For
                End If
            Next
        End If
    End If
End Sub
Hi bạn. mình đã làm được rồi. cảm ơn bạn nhiều lắm, nhưng mình cần thêm 1 vấn đề bạn giúp mình luôn nha :
1 là khi mà trùng 2 cột A và C thì sẽ tất cả các thông tin khác sẽ không nhập được luôn.
2 là sao cái thông báo nó lại có sô 9 ở cuối. bạn xem hình nha. thank bạnCapturess.PNG
 
Upvote 0
Hi bạn. mình đã làm được rồi. cảm ơn bạn nhiều lắm, nhưng mình cần thêm 1 vấn đề bạn giúp mình luôn nha :
1 là khi mà trùng 2 cột A và C thì sẽ tất cả các thông tin khác sẽ không nhập được luôn.
2 là sao cái thông báo nó lại có sô 9 ở cuối. bạn xem hình nha. thank bạn
Thay khúc giữa bằng đoạn này:
Rich (BB code):
                If Range("A" & i) & "-" & Range("C" & i) = sKey Then
                    Application.EnableEvents = False
                    Range("A" & Target.Row & ":E" & Target.Row).Value = ""
                    Application.EnableEvents = True
                    MsgBox "DA NHAP TRUNG DONG " & i & vbNewLine & "VUI LONG NHAP LAI!"
                    Exit For
                End If
 
Upvote 0
Thay khúc giữa bằng đoạn này:
Rich (BB code):
                If Range("A" & i) & "-" & Range("C" & i) = sKey Then
                    Application.EnableEvents = False
                    Range("A" & Target.Row & ":E" & Target.Row).Value = ""
                    Application.EnableEvents = True
                    MsgBox "DA NHAP TRUNG DONG " & i & vbNewLine & "VUI LONG NHAP LAI!"
                    Exit For
                End If
hi bạn ,giờ thì 2 cột này vẫn còn ạ, bạn có thể giúp nốt cho mình dc ko ạCapturessss.PNG
 
Upvote 0

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

Back
Top Bottom