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

Liên hệ QC
V

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 !
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
van80 đã viết:
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 !
Nhấp chuột vào đây để mở rộng...
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

  • filemau.rar
    8.4 KB · Đọc: 44
Upvote 0
nghiaphuc đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
nhapmon đã viết:
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ó)
Nhấp chuột vào đây để mở rộng...
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
ChanhTQ@ đã viết:
[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
Nhấp chuột vào đây để mở rộng...
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
van80 đã viết:
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 !
Nhấp chuột vào đây để mở rộng...
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
nghiaphuc đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
van80 đã viết:
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 !
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
nhapmon đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
van80 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
nghiaphuc đã viết:
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]
Nhấp chuột vào đây để mở rộng...
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
van80 đã viết:
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 !
Nhấp chuột vào đây để mở rộng...
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
nghiaphuc đã viết:
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]
Nhấp chuột vào đây để mở rộng...
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
van80 đã viết:
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 !
Nhấp chuột vào đây để mở rộng...
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
nghiaphuc đã viết:
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]
Nhấp chuột vào đây để mở rộng...
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
van80 đã viết:
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 !
Nhấp chuột vào đây để mở rộng...
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
van80 đã viết:
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 !
Nhấp chuột vào đây để mở rộng...
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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

A
Công thức tính tổng chi phí nhiều điều kiện
Trả lời
5
Đọc
57
hoangtuaotrang_hp_vn
H
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
1
Đọc
21
YaoChan
YaoChan
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
5
Đọc
273
vostro 1500
vostro 1500
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
167
Đọc
9K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
T
Lọc lấy đơn giá nhập mới nhất của các mặt hàng
2
Trả lời
20
Đọc
14K
honguyentruong
H
nguyenanhhoa
Nhờ các bác giúp: e muốn tô màu khác nhau đối với các ô giống nhau về giá trị
    • Cười
Trả lời
3
Đọc
69
huhumalu
H
C
Tiếng Việt
    • Cười
2
Trả lời
28
Đọc
1K
ptm0412
ptm0412
Hai Lúa Miền Tây
  • Question
Hàm chuyển dữ liệu từ cột sang dòng (Hàm melt + wide_to_long của Python trong Excel)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
10
Đọc
579
Hai Lúa Miền Tây
Hai Lúa Miền Tây
H
Cộng các ô cùng màu bằng VBA
Trả lời
2
Đọc
63
haquyet2013
H
N
  • Question
Xin mã code ẩn hiện dòng theo yêu cầu
Trả lời
9
Đọc
453
Nguyễn Diêu Hiền
N
N
trích xuất doanh thu của từng nhân viên theo từng ngày từ bảng gốc sang bảng khác
Trả lời
1
Đọc
51
Duy Tùng 9x
Duy Tùng 9x
Q
Giúp em xử lý lỗi macro khi chạy VBA
Trả lời
15
Đọc
304
huhumalu
H
ptm0412
  • Question
Tài liệu hướng dẫn Power query cơ bản và nâng cao
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
3
Đọc
7K
trieunguyenkimtu
T
T
Chèn dữ liệu từ sheet này qua sheet khác theo điều kiện
Trả lời
0
Đọc
53
Thulib
T
D
Thêm code VBA tính số lượng đã xuất và tồn cuối theo FIFO lô hàng
Trả lời
5
Đọc
195
huuthang_bd
huuthang_bd
T
Ký tự đặc biệt đại diện cho các ký tự khác trong vba là gì
Trả lời
4
Đọc
105
huhumalu
H
C
Xin code vba hàm vlookup
Trả lời
1
Đọc
498
duykhanh3488
D
hoamattroicoi
Thông tin dự kiến mở lớp học VBA căn bản ở Hải Phòng
    • Thích
    • Ngạc nhiên
    • Yêu thích
2
Trả lời
37
Đọc
23K
duykhanh3488
D
P
Lỗi : chỉ tự động định dạng ngày tháng nếu nhấp double click vào ô.
Trả lời
5
Đọc
10K
duykhanh3488
D
T
Tính tổng có điều kiện cho nhiều sheet trên excel
Trả lời
5
Đọc
85
duykhanh3488
D
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom