Nhờ viết dùm code cảnh báo nhập dữ liệu (1 người xem)

[Bong0503]

Nhờ anh chị và các bạn viết dùm đoạn code cảnh báo nhập dữ liệu. Yêu cầu như trong file đính kèm.
Chân thành cảm ơn!

 

[phulien1902]

Nhờ anh chị và các bạn viết dùm đoạn code cảnh báo nhập dữ liệu. Yêu cầu như trong file đính kèm.
Chân thành cảm ơn!

1 cách
+ Code cho Sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("D3:D3000")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Application.EnableEvents = True
End Sub

+ Code cho Module:

Sub abc()
    Dim i&, j&
    Application.ScreenUpdating = False
    For j = 3 To 15
        For i = 3 To 509
            If Cells(i, j).Value > Cells(i, j + 1).Value And Cells(i, j + 1) <> 0 Then
                MsgBox " Xem lai DL nhap!" & " " & Cells(i, j + 1).Address
                Cells(i, j + 1).ClearContents: Cells(i, j + 1).Select
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub

 

[Bong0503]

1 cách
+ Cho cho Module:

Sub abc()
   Dim i&, j&
  Application.ScreenUpdating = False
     For j = 3 To 15
       For i = 3 To 500
        If Cells(i, j).Value > Cells(i, j + 1).Value And Cells(i, j + 1) <> 0 Then
         MsgBox " Xem lai DL nhap!" & Cells(i, j + 1).Address
          Cells(i, j + 1).ClearContents: Cells(i, j + 1).Select
        End If
       Next
    Next
Application.ScreenUpdating = True
End Sub

Cám ơn Bạn nhiều.
Với yêu cầu đầu tiên code đã đáp ứng tốt. bạn có thể code thêm yêu cầu thứ 2 dùm mình đước không
Nếu sử dụng kỳ hiện tại Cột P (giá trị ở cột P = kỳ sau - kỳ trước ) mà lớn hơn 1,5 lần hoặc gấp đôi kỳ trước (cột S) thì sẽ có cảnh báo kiểm tra ghi chỉ số hoặc nhập dữ liệu .
Chân thành cảm ơn bạn!

 

[phulien1902]

Cám ơn Bạn nhiều.
Với yêu cầu đầu tiên code đã đáp ứng tốt. bạn có thể code thêm yêu cầu thứ 2 dùm mình đước không
Nếu sử dụng kỳ hiện tại Cột P (giá trị ở cột P = kỳ sau - kỳ trước ) mà lớn hơn 1,5 lần hoặc gấp đôi kỳ trước (cột S) thì sẽ có cảnh báo kiểm tra ghi chỉ số hoặc nhập dữ liệu .
Chân thành cảm ơn bạn!

+ Code Sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C3:O509")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Call abc
    Call xyz
    Application.EnableEvents = True
End Sub

+ Code Module:

Sub abc()
    Dim i&, j&
    Application.ScreenUpdating = False
    For j = 3 To 15
        For i = 3 To Cells(Rows.Count, 1).End(3).Row
            If Cells(i, j).Value > Cells(i, j + 1).Value And Cells(i, j + 1) <> 0 Then
                MsgBox " Xem lai DL nhap!" & " " & Cells(i, j + 1).Address
                Cells(i, j + 1).ClearContents: Cells(i, j + 1).Select
            End If
        Next
    Next
    Application.ScreenUpdating = True
End Sub
Sub xyz()
    Dim i&
    Application.ScreenUpdating = False
    For i = 3 To Cells(Rows.Count, 1).End(3).Row
        If Cells(i, 16).Value > 1.5 * Cells(i, 19).Value Then
            MsgBox " Xem lai gia tri:" & vbLf & Cells(i, 16).Address & vbLf & Cells(i, 19).Address
        End If
        Exit Sub
    Next
    Application.ScreenUpdating = True
End Sub

 

[Bong0503]

Bạn thử:

Sub abc2()
   Dim i&, j&
    Application.ScreenUpdating = False
     For j = 3 To 15
       For i = 3 To 500
        If Cells(i, j).Value > Cells(i, j + 1).Value And Cells(i, j + 1) <> 0 Then
         MsgBox " Xem lai DL nhap!" & " " & Cells(i, j + 1).Address
          Cells(i, j + 1).ClearContents: Cells(i, j + 1).Select
        End If
        If Cells(i, 16).Value > 1.5 * Cells(i, 19).Value Then
        MsgBox " Xem lai gia tri:" & vbLf & Cells(i, 16).Address & vbLf & Cells(i, 19).Address
        Exit Sub
        End If
       Next
    Next
Application.ScreenUpdating = True
End Sub

Cám ơn bạn nhiều.
Chúc ngủ ngon!

 

[phulien1902]

Cám ơn bạn nhiều.
Chúc ngủ ngon!

Tôi đã sửa lại, tất cả trong bài #4.

 

[Bong0503]

Tôi đã sửa lại, tất cả trong bài #4.

Cám ơn bạn nhiều, để mình test lại nhé!

 

[Bong0503]

Tôi đã sửa lại, tất cả trong bài #4.

Lần này thì chuẩn rồi bạn, không còn lỗi nữa. Chân thành cảm ơn bạn!

 

[be_09]

Nhờ anh chị và các bạn viết dùm đoạn code cảnh báo nhập dữ liệu. Yêu cầu như trong file đính kèm.
Chân thành cảm ơn!

Không phải cái gì cũng phải cần đến code, chỉ cần làm đơn giản vầy thôi.
1/ Dùng cột phụ R-P.
2/ Dùng hàm If, nếu cột phụ là số âm cho ra kết quả là chữ Sai, số dương thì bỏ qua.

 

[Bong0503]

Tôi đã sửa lại, tất cả trong bài #4.

Bạn vui lòng kiểm tra lại dùm mình, trường hợp thứ 2 Nếu sử dụng kỳ hiện tại Cột P (giá trị ở cột P = kỳ sau - kỳ trước ) mà lớn hơn 1,5 lần hoặc gấp đôi kỳ trước (cột S) thì sẽ có cảnh báo kiểm tra ghi chỉ số hoặc nhập dữ liệu . code chỉ đáp ứng dòng đầu tiên trong bảng dữ liệu, từ dòng thứ 2 trở đi không đúng, hôm qua mình cũng chỉ test dòng đầu tiên.
Cám ơn bạn nhiều!

 

[phulien1902]

Bạn vui lòng kiểm tra lại dùm mình, trường hợp thứ 2 Nếu sử dụng kỳ hiện tại Cột P (giá trị ở cột P = kỳ sau - kỳ trước ) mà lớn hơn 1,5 lần hoặc gấp đôi kỳ trước (cột S) thì sẽ có cảnh báo kiểm tra ghi chỉ số hoặc nhập dữ liệu . code chỉ đáp ứng dòng đầu tiên trong bảng dữ liệu, từ dòng thứ 2 trở đi không đúng, hôm qua mình cũng chỉ test dòng đầu tiên.
Cám ơn bạn nhiều!

Tôi nghĩ trường hợp thứ 2 của bạn, dùng Code dưới đây sẽ đơn giản và liệt kê được tất cả các trường hợp không thỏa mãn

Sub xyz2()
    Dim i&
    Application.ScreenUpdating = False
    For i = 3 To Cells(Rows.Count, 1).End(3).Row
        If Cells(i, 16).Value > 1.5 * Cells(i, 19).Value Then
            Debug.Print Cells(i, 16).Address & "-" & Cells(i, 19).Address
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[Bong0503]

Tôi nghĩ trường hợp thứ 2 của bạn, dùng Code dưới đây sẽ đơn giản và liệt kê được tất cả các trường hợp không thỏa mãn
[/php]

Cám ơn bạn. Mình đã test riêng từng sub trong bài #4 thì đáp ứng đúng yếu cầu.
nhưng nếu gọi 2 sub tròng cùng sự kiện Worksheet_Change thì sẽ có 1 trong 2 sub chạy không đúng ( tùy mình gọi sub nào trước). Nếu có thể bạn fix lại dùm mình.
Chân thành cảm ơn bạn!

 

[phulien1902]

Cám ơn bạn. Mình đã test riêng từng sub trong bài #4 thì đáp ứng đúng yếu cầu.
nhưng nếu gọi 2 sub tròng cùng sự kiện Worksheet_Change thì sẽ có 1 trong 2 sub chạy không đúng ( tùy mình gọi sub nào trước). Nếu có thể bạn fix lại dùm mình.
Chân thành cảm ơn bạn!

Trở lại bài #4, bạn thay Sub xyz bằng Sub xyz2
Bạn thử lại nhé.

 

[Bong0503]

Trở lại bài #4, bạn thay Sub xyz bằng Sub xyz2
Bạn thử lại nhé.

Không được bạn ạ, Nếu gọi sub abc trước thì sub xyz2 sẽ không chạy, cũng giống như trường hợp sub xyz vậy.
Mình không rành về code nhưng mình thử msgbox Cells(i, 16) lúc nào cũng trả về $P$3 và $S$3
Dù sao cũng cám ơn bạn rất nhiều.!

 

[phulien1902]

Không được bạn ạ, Nếu gọi sub abc trước thì sub xyz2 sẽ không chạy, cũng giống như trường hợp sub xyz vậy.
Mình không rành về code nhưng mình thử msgbox Cells(i, 16) lúc nào cũng trả về $P$3 và $S$3
Dù sao cũng cám ơn bạn rất nhiều.!

Tôi nói với bạn là chép Sub xyz2 dán vào Sub xyz.
+ Kết quả trong trường hợp 1 thì hiện ngay trên bảng tính, vì tôi dùng MsgBox
+ Kết quả trường hợp 2, bạn phải vào cửa sổ VBA, gõ Ctrl+G mới thấy( như hình bên dưới)

 

[Bong0503]

Tôi nói với bạn là chép Sub xyz2 dán vào Sub xyz.

mình đã làm như bạn nói

Ý mình không phải là cái msgbox trong code của bạn, Ý mình là cho dù mình nhập liệu tới dòng nào đi nữa mình thay cái Msgbox của bạn bằng cái msg box của mình nó đều trả về giá trị của ô đầu tiên ở cột P (cụ thể là ô P3).
Có khi nào tại số lượng sheet trong file mình đang làm nó nhiều quá nên kết quả không đúng không?
File mình nhờ bạn giúp là sheet mình tách ra từ file mình đang làm không khác gì với file mình đã up.
Mình sẽ kiểm tra lại lần nữa xem sao.
Cám ơn bạn!

 

[Bong0503]

đây là cửa sổ nhập liệu của mình

đây là trong vba

 

[phulien1902]

đây là cửa sổ nhập liệu của mình
View attachment 195961
đây là trong vba
View attachment 195962

Bạn gửi File có hình chụp lên đây tôi xem nó thế nào nhé.