Code tạo cảnh báo khi xóa cell

[DungMD]

Hiện tại tôi có code tạo cảnh báo khi xóa hoặc thay đổi dữ liệu của các ô
Tuy nhiên có 1 vấn đề là khi điền mới ( vào ô blank) thì vẫn hiện cảnh báo.
Vậy có cách nào loại trừ trường hợp này không ?
Tôi xin cảm ơn

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range


' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:Q1110")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If MsgBox("Du lieu o " & Target.Address & "da thay doi" & Chr(13) & _
"Co muon luu lai thay doi khong ?", vbQuestion + vbYesNo) = vbNo _
Then Target.Value = tam2
thoat:
Target.Offset(1, 0).Select
Application.EnableEvents = True


End If
End Sub

 

[Maika8008]

Thay toàn bộ code bài #1 thành:

Public D, tam2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:Q1110")) Is Nothing Then
        D = Target.Value
        tam2 = Target.Value
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:Q1110")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If Not IsEmpty(D) Then
    If MsgBox("Du lieu o " & Target.Address & "da thay doi" & Chr(13) & _
    "Co muon luu lai thay doi khong ?", vbQuestion + vbYesNo) = vbNo Then
        Application.EnableEvents = False
        Target.Value = tam2
        Application.EnableEvents = True
    End If
End If
thoat:
Target.Offset(1, 0).Select
End If
End Sub

 

[DungMD]

Thay toàn bộ code bài #1 thành:

Public D, tam2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:Q1110")) Is Nothing Then
        D = Target.Value
        tam2 = Target.Value
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:Q1110")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If Not IsEmpty(D) Then
    If MsgBox("Du lieu o " & Target.Address & "da thay doi" & Chr(13) & _
    "Co muon luu lai thay doi khong ?", vbQuestion + vbYesNo) = vbNo Then
        Application.EnableEvents = False
        Target.Value = tam2
        Application.EnableEvents = True
    End If
End If
thoat:
Target.Offset(1, 0).Select
End If
End Sub

Tôi cảm ơn bạn nhiều .

Bài đã được tự động gộp: 17/7/21

Thay toàn bộ code bài #1 thành:

Public D, tam2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:Q1110")) Is Nothing Then
        D = Target.Value
        tam2 = Target.Value
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:Q1110")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If Not IsEmpty(D) Then
    If MsgBox("Du lieu o " & Target.Address & "da thay doi" & Chr(13) & _
    "Co muon luu lai thay doi khong ?", vbQuestion + vbYesNo) = vbNo Then
        Application.EnableEvents = False
        Target.Value = tam2
        Application.EnableEvents = True
    End If
End If
thoat:
Target.Offset(1, 0).Select
End If
End Sub

Code có 1 vấn đề khi coppy nhiều cell vào ô trống thì vẫn hiện cảnh báo bạn ạ

 

[Maika8008]

Tôi cảm ơn bạn nhiều .

Bài đã được tự động gộp: 17/7/21

Code có 1 vấn đề khi coppy nhiều cell vào ô trống thì vẫn hiện cảnh báo bạn ạ

Không hề!
Không biết trong file bạn có lẫn lộn code gì không?

P/S: Tiện thể: bạn bỏ dòng Target.Offset(1, 0).Select đi, không cần thiết!

 

[DungMD]

Không hề!
Không biết trong file bạn có lẫn lộn code gì không?

P/S: Tiện thể: bạn bỏ dòng Target.Offset(1, 0).Select đi, không cần thiết!

À ý là khi coppy cell A3 sau đó paste nó vào A3 :A5 chẳng hạn ( dòng blank ) thì vẫn bị hiện thông báo. Chỉ ko hiện thông báo khi coppy dãy số khác vào

 

[Maika8008]

À ý là khi coppy cell A3 sau đó paste nó vào A3 :A5 chẳng hạn ( dòng blank ) thì vẫn bị hiện thông báo. Chỉ ko hiện thông báo khi coppy dãy số khác vào

Thay:
If Not IsEmpty(D) Then
Bằng:
If Not IsEmpty(D) And Not IsArray(D) Then

 

[DungMD]

Thay:
If Not IsEmpty(D) Then
Bằng:
If Not IsEmpty(D) And Not IsArray(D) Then

Tôi xin cảm ơn bạn nhiều