Data Valiadation rất hiệu quả.
Do Data Valiadation thì khi thực hiện copy thì nó lại không báo lỗi, chỉ có đánh trực tiếp mới báo lỗi nên mình tìm VBA, bạn có cách nào giúp mình với ạ.
1. Copy cũng không kích hoạt sự kiện (VBA). Những chắp vá đều chỉ có hiệu quả tương đối.
Cảm ơn bạn nhiều nhé
Nhờ bạn sửa lại code giúp mình khi copy và dán vào cột B thì vẫn thực hiện được thông báo. Cảm ơn bạn nhiều
Hỏi cụ thể chút về cách nhập liệu của bạn, tức là bạn có cột ngày và số lượng sẵn từ trước? Chỉ nhập tên nhân viên thôi phải không? Hay là cứ mỗi dòng nhập tên NV xong nhập ngày và số lượng?
Nhập cả tên nhân viên ngày và số lượng nữa bạn, hiện thông báo và xoá giá trị nhập sai bạn nhé, cảm ơn bạn.
Ngồi viết thử một khúc thì nhận ra có nhiều vấn đề:
Thử xem.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B5:B100000")) Is Nothing Then
On Error GoTo Thoat
Call HanCheChi
If IsArray(Targer) = False Then
Set Rng = Target
k = Rng.Rows.Count
Set eRng = Rng.Resize(k, 3)
For j = 1 To k
For i = 1 To UBound(Res)
If eRng(j, 1) = Res(i, 1) And eRng(j, 2) = Res(i, 2) And Res(i, 3) > Sheet1.[H3] Then
MsgBox "Ngày " & eRng(j, 2) & " Nhân viên " & eRng(j, 1) & " đa chi quá han mưc", vbCritical, " THÔNG BÁO"
eRng(j, 3) = ""
End If
Next i
Next j
End If
End If
Thoat:
End SubSự kiện chỉ bắt mỗi cột B làm sao mà được bác. Người ta trả lời thế này mà:
Nhập tên xong, chưa có tiền thì mọi sự vẫn tốt đẹp. Nhưng đến khi nhập tiền vào, nếu vượt thì code có bắt sự kiện này nữa đâu
Tôi nghĩ rằng 1 thành viên tham gia diễn đàn từ năm 2012 như chủ thớt chắc có đủ kiến thức để tùy chỉnh theo ý mình. Nếu mà làm nữa thì họ học được gì?
1.Trong vùng paste mà có nhân viên không thỏa mãn điều kiện thì xóa những nhân viên không thỏa mãn điều kiện đó ở vùng paste, những nhân viên trong vùng paste thỏa mãn điều kiện thì giữ lại.
Có thể là học thêm được tính kiên nhẫn và sẽ nhờ làm tiếp đến khi đạt mong muốn.
Vẫn còn đơn giản chán vì bạn vẫn chưa xét hết các trường hợp.
1. Dòng 7-11 ( ngoài vùng dán) sẽ không bị xóa, chỉ xét xóa từ 4-6 ( trong vùng dán) thứ tự xét lần lượt dòng 4 đến dòng 6 :
Thì tôi viết rõ mà, chỉ là đoán mò thôi. Bạn có mô tả hết các trường hợp đâu mà muốn người khác viết code. Không có bài của tôi thì riêng việc thống nhất cách xử lý cũng phải vài bài nữa. Vì thế tôi không tham gia. Tôi chỉ "giao lưu" với người khác thôi.
Lúc đầu em cũng không để ý, nhưng đến bác nói thì em có cảm giác như là đang giao việc thật. Nhưng thôi em cũng không quan tâm lắm, vì thấy cũng trả lời vào trọng tâm câu hỏi.
Bạn dán code này vào module sheet1, chạy thử xem có vấn đề gì không:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("B5:D" & Rows.Count)) Is Nothing Then
Static Dic As Object
Dim sArr(), Arr(), Lr&, I&, iKey$, Str$
Const iMax# = 1000000#, N$ = vbNullString
If Dic Is Nothing Then Set Dic = CreateObject("Scripting.Dictionary") Else Dic.RemoveAll
Lr = Cells(Rows.Count, "B").End(xlUp).Row
sArr = Range("B5:D" & Lr).Value2
Arr = Range(Cells(Target.Row, "B"), Cells(Target.Rows(Target.Rows.Count).Row, "D")).Value2
For I = 1 To UBound(sArr)
iKey = sArr(I, 1) & "|" & sArr(I, 2)
Dic(iKey) = Dic(iKey) + sArr(I, 3)
Next
For I = UBound(Arr) To 1 Step -1
iKey = Arr(I, 1) & "|" & Arr(I, 2)
If Dic(iKey) > iMax Then
If InStr(1, Str, Arr(I, 1), 1) = 0 Then
Str = Str & vbNewLine & "NhanVien: " & Arr(I, 1)
End If
Dic(iKey) = Dic(iKey) - Arr(I, 3)
Arr(I, 1) = N: Arr(I, 2) = N: Arr(I, 3) = N
End If
Next
Cells(Target.Row, "B").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
If Len(Str) Then
Str = "Cac ma sau khong thoa man, da xoa: " & Str
MsgBox "Xong! " & Str
End If
End If
Application.EnableEvents = True
End SubMình chạy thấy không có mã nào bị xóa nhưng vẫn luôn hiện thông báo, còn về kết quả thì đúng rồi. Cảm ơn bạn nhé!
Hình như khúc đó tôi nghĩ cái gì không nhớ nữa mới thêm một khúc vào, đã sửa lại code xóa khúc đó nhé!
Cảm ơn bạn rất nhiều.
