Hỏi về thông báo lỗi khi nhập liệu thiếu
- Thread starter tam8678
- Ngày gửi
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
Mình dùng code :
Xem file :
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [B:D]) Is Nothing Or Target = "" Then Exit Sub
If Cells(Target.Row, 1) = "" Then
MsgBox "Nhap thieu roi ban!", vbCritical
Target = ""
Cells(Target.Row, 1).Select
End If
End SubXem file :
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Em nghĩ Validation có thể làm tốt điều này (mà lại nhanh hơn code)... vậy tại sao anh không dùng nhỉ?
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Code này chỉ đúng khi người ta nhập trực tiếp ---> Nếu họ copy từ nơi khác rồi paste vào thì code không hoạt động!
Bạn cải tiến lại code nhé (dùng vòng lập)
Upvote
0
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
Em làm thêm cách dùng Validation :
PHP:
=OFFSET(B8,,COLUMN($A8)-COLUMN())<>""Em sẽ cải tiến tiếp sau khi...ăn cơm
Lần chỉnh sửa cuối:
Upvote
0
---
Cám ơn chú.
Vẫn đang đau đầu vì code của bạn ptlong04x1 khi nhập liệu thì đúng, nhưng khi paste thì bó tay. Chú cho anh hỏi có code nào mà trị được vừa nhập liệu bằng tay vừa paste không ( khổ nỗi là paste không ).
---
1- Đầy đủ thông tin thì file nó như thế này nhờ chú và các anh em xem giúp, đặc biệt nó có liên quan đến Khối Quy Cách, Mã Quy Cách Kiện và Tổng Cộng Khối ( gặp copy -> paste thì thua thật ).
Nếu không rõ xin anh em thông báo.
Đính kèm file
---
Chú Ý:
2- Thông thường chỉ paste từ A8 đến E..
- Công thức tính Khối Quy Cách, Mã Quy Cách Kiện và Tổng Cộng Khối đều nằm trong code ( Nhập liệu bằng tay thì tự tính, gặp paste thì cũng liệt luôn )
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Anh thử code này xem:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Clls As Range
Application.EnableEvents = False
If Not Intersect(Range("B8:E1000"), Target) Is Nothing Then
For Each Clls In Target
If Not IsEmpty(Clls) And IsEmpty(Cells(Target.Row, "A")) Then
MsgBox "Ban chua nhap day du tai cot A", vbCritical
Target.ClearContents
Clls.Select: GoTo KT
End If
Next
End If
KT:
Application.EnableEvents = True
End Sub
Upvote
0
Còn đây nữa chú ơi:
Cụ thể trong file đính kèm.
( Chú và bạn ptlong04x12 nghĩ ăn cơm đi )
---
Anh đã test code, code "Chết" trong trường hợp nhập vào Số kiện 1 dòng mà Paste vào >1 dòng thì không đạt.
Lần chỉnh sửa cuối:
Upvote
0
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
Anh thử file xem :
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range, Emp As Boolean
If Intersect(Target, [B:E]) Is Nothing Or _
WorksheetFunction.CountA(Target) = 0 Then Exit Sub
For Each Cll In Target
If Cells(Cll.Row, 1) = "" Then
Cll = ""
Cells(Cll.Row, 1).Select
Emp = True
End If
Next Cll
If Emp = True Then MsgBox "Nhap thieu", vbCritical
For Each Cll In Range("F8", "F" & [A65536].End(xlUp).Row)
If Cll.Offset(, -5) <> "" Then
Cll.FormulaR1C1 = "=RC[-4]*RC[-3]*RC[-2]*RC[-1]/10^9"
Cll.Offset(, 1).FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]&RC[-6]"
End If
Next Cll
Range("G4").Formula = "=SUM($F$8:" & [F65536].End(xlUp).Address & ")"
End Sub
Upvote
0
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
Em test thử thấy có vấn đề như sau :
Nếu cột A có dữ liệu không liên tục trên các hàng mà mình paste dữ liệu vào thì code không hoạt động.
Upvote
0
---
Cám ơn bạn ptlong04x12 nhiều, test code trong trường hợp sau thì vẫn lỗi:
- Khi paste từ dòng đầu tiên, nếu không có số kiện => ra thông báo => Đúng, nhưng công thức xóa mất tiêu đề cột.
- Nếu số dòng trong kiện > số dòng paste : phải xóa số kiện thừa ( nếu phức tạp quá thì xóa tay cũng được )
Để đơn giản vấn đề anh chỉ cần:
- Đã ra thông báo thì không cập nhật công thức ( cho dòng đầu tiên )
Upvote
0
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
Trong File dưới, mình đã sửa cái này, ô nào chưa có số kiện thì sẽ không điền công thức và sẽ tự động xóa số kiện thừa.
Cái này mình không hiểu, khi chọn vùng dữ liệu để Copy thì bạn không chọn dòng tiêu đề, sau đó paste vào ở dưới dòng tiêu đề có sẵn thì làm sao mất dòng tiêu đề được.
Upvote
0
---
Cụ thể là như vầy nè bạn ơi:
Mong bạn hiểu cho, vì vậy mới xảy ra trường hợp như thế.
Mong tin.
Upvote
0
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
Bạn dùng tạm File này cái đã, có gì sẽ sửa tiếp.
Thao tác của mình như sau :
1.Copy số kiện paste vào cột A, bắt đầu từ [A8] hoặc dưới [A8] đều được (dưới dòng tiêu đề).
2. Copy dữ liệu gồm 4 cột, paste vào các cột B --> E, bắt đầu từ [B8] hoặc dưới [B8] đều được (dưới dòng tiêu đề).
3. Hai cột G, H sẽ tự điền, các dòng thừa tự động xóa.
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Sơ suất ---> Câu này:
If Not IsEmpty(Clls) And IsEmpty(Cells(Target.Row, "A"))
Lý ra phải là:
If Not IsEmpty(Clls) And IsEmpty(Cells(Clls.Row, "A"))
Sửa lại:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Clls As Range
Application.EnableEvents = False
If Not Intersect(Range("B8:E1000"), Target) Is Nothing Then
For Each Clls In Target
If Not IsEmpty(Clls) And IsEmpty(Cells(Clls.Row, "A")) Then
MsgBox "Ban chua nhap day du tai cot A", vbCritical
Target.ClearContents
Clls.Select: GoTo KT
Else
Cells(Clls.Row, "F") = "=RC[-4]*RC[-3]*RC[-2]*RC[-1]/1000000000"
Cells(Clls.Row, "G") = "=RC[-6]*RC[-5]*RC[-4]*RC[-3]"
End If
Next
End If
KT:
Application.EnableEvents = True
End Sub
Lần chỉnh sửa cuối:
Upvote
0
ptlong04x1
Thành viên tích cực
- Tham gia
- 15/10/08
- Bài viết
- 1,031
- Được thích
- 1,531
- Nghề nghiệp
- Kỹ sư xây dựng
1. Còn chỗ này ạ : nếu số kiện đã điền trước trên 5 dòng, mà paste dữ liệu vô 10 dòng thì đáng ra phải dữ lại 5 dòng đầu, tuy nhiên --> code xoá hết cả 10 dòng.
2. Anh Tâm còn yêu cầu, khi số kiện có 10 dòng mà dữ liệu paste vào có 5 dòng thì xoá đi 5 dòng số kiện thừa, và xoá luôn cả công thức thừa bên mấy cột F,G.
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Bạn Long nghiên cứu code không dùng vòng lập thử xem ---> Mình nghĩ là hoàn toàn có thể đấy (cái khó nhất đối với trường hợp này là đưa MsgBox vào chổ nào)
Bạn thử xem! (Tôi cũng là làm gần xong nhưng chưa hài lòng lắm nên không đưa lên)
Upvote
0
---
Xin được phép cho tôi nói vàl lời:
Tôi không giỏi về code, chính vì thế tôi "đặc biệt" rất kỷ về khâu nhập liệu, vì thực tế tôi đã gặp không biết bao nhiêu trường hợp xảy ra thuộc về loại "ngớ ngẩn" của người nhập liệu. Chính vì thế nên tôi mới có yêu cầu thật sự khắt khe đến như thế.
Tôi rất trân trọng chú NDU, bạn ptlong04x1, nhưng tôi không dám nhận câu:
Bản thân tôi thì cũng vui lắm rồi vì các anh em nhiệt tình và chỉ xin nhận câu :
---
Trân trọng.
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,952
Code mà tôi nói không dùng vòng lập đây:
Đương nhiên tốc độ sẽ nhanh hơn so với có vòng lập
Code cho phép:
- Nhập liệu mà cột A chưa có dử liệu nó sẽ xóa toàn bộ dòng này
- Copy và paste vào, nó sẽ dò bên cột A, ô nào trống, xóa luôn dòng ấy
- Cho phép xóa dử liệu ---> Nếu xóa 1 vài cell thì không sao, nhưng nếu xóa nguyên dòng 1 cột B đến cột F thì nó sẽ xóa luôn cột A và 2 cột công thức
Vấn đề là cho MsgBox vào chổ nào đây!
Mời bạn Long thử sức (sướng nhé)
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DataRng As Range
Application.EnableEvents = False
If Not Intersect(Range("B8:E1000"), Target) Is Nothing Then
Set DataRng = Intersect(Target.EntireRow, Range("B8:E1000"))
With Intersect(Target.EntireRow, Range("F:F"))
.Offset(, 0).Value = "=RC[-4]*RC[-3]*RC[-2]*RC[-1]/1000000000"
.Offset(, 1).Value = "=RC[-6]*RC[-5]*RC[-4]*RC[-3]"
End With
On Error Resume Next
With Range("A7:G1000")
Intersect(.Resize(, 1).SpecialCells(4).EntireRow, .Cells).ClearContents
End With
If DataRng.Columns.Count = 4 Then
On Error GoTo Tiep
If DataRng.SpecialCells(4).Count = DataRng.Count Then
Intersect(DataRng.EntireRow, Range("A:G")).ClearContents
End If
Tiep:
End If
End If
Application.EnableEvents = True
End SubCode cho phép:
- Nhập liệu mà cột A chưa có dử liệu nó sẽ xóa toàn bộ dòng này
- Copy và paste vào, nó sẽ dò bên cột A, ô nào trống, xóa luôn dòng ấy
- Cho phép xóa dử liệu ---> Nếu xóa 1 vài cell thì không sao, nhưng nếu xóa nguyên dòng 1 cột B đến cột F thì nó sẽ xóa luôn cột A và 2 cột công thức
Vấn đề là cho MsgBox vào chổ nào đây!
Mời bạn Long thử sức (sướng nhé)
Upvote
0
concogia
Gội rồi mới Cạo
- Tham gia
- 17/9/09
- Bài viết
- 3,412
- Được thích
- 6,876
Theo mình nghĩ nếu khó quá sao ta không làm thêm một bước nữa . Thí dụ trong bảng đó bạn sử dụng copy và dán nhiều ta có thể kiểm tra và xóa những thứ không mong muốn đi chứ:
Private Sub loaitru()
'cot A khong co du lieu thi xoa het cac o tu B tren dong do'
Dim i As Integer
For i = 0 To 30
If Cells(8 + i, 1) = "" Then
Range(Cells(8 + i, 2), Cells(8 + i, 5)).Clear
End If
Next i
End Sub
Cái nào bạn nhập trực tiếp đã có code của các bạn kia xử lý rồi phải không?
Thân
Private Sub loaitru()
'cot A khong co du lieu thi xoa het cac o tu B tren dong do'
Dim i As Integer
For i = 0 To 30
If Cells(8 + i, 1) = "" Then
Range(Cells(8 + i, 2), Cells(8 + i, 5)).Clear
End If
Next i
End Sub
Cái nào bạn nhập trực tiếp đã có code của các bạn kia xử lý rồi phải không?
Thân
Upvote
0
Bài viết mới nhất
- Question
- Đã giải quyết
- Question
- Question
- Question
