Bị lỗi với sự kiện WorkSheet_Change khi copy paste (1 người xem)

[redosolo]

Mình có file này. Nếu nhập liệu từ chính file thì ko sao, nhưng khi copy và paste vào file thì nó tự động tính là WorkSheet_change.
Theo như trong file thì khi đánh sai số DT thì nó sẽ tô đỏ ô đó ở cột D, nhưng khi mình copy dữ liệu từ 1 file khác vào thì nó sẽ tô đỏ tất cả những dữ liệu được copy.
Mình không bít cách làm sao để khắc phục vấn đề đó. Các bạn coi file đính kèm giùm mình nha.

 

[nghiaphuc]

Mình có file này. Nếu nhập liệu từ chính file thì ko sao, nhưng khi copy và paste vào file thì nó tự động tính là WorkSheet_change.
Theo như trong file thì khi đánh sai số DT thì nó sẽ tô đỏ ô đó ở cột D, nhưng khi mình copy dữ liệu từ 1 file khác vào thì nó sẽ tô đỏ tất cả những dữ liệu được copy.
Mình không bít cách làm sao để khắc phục vấn đề đó. Các bạn coi file đính kèm giùm mình nha.

Thử sửa lại code như vầy xem sao, những chỗ màu đỏ là tôi sửa hoặc thêm vào (làm biếng viết lại code nên tôi chỉ chỉnh sửa từ code có sẵn của bạn thôi):

Private Sub Worksheet_Change(ByVal Target As Range)
    [COLOR=#ff0000]Dim Cll As Range[/COLOR]
    On Error Resume Next
    With Range("D:D")
        If Not Intersect(Target, .Cells) Is Nothing Then
            Dim a, b, c
            [COLOR=#ff0000]For Each Cll In Target[/COLOR]
                a = Left([COLOR=#ff0000]Cll[/COLOR], 2)
                b = Len([COLOR=#ff0000]Cll[/COLOR])
                If (a = "09" And b = 10) Or (a = "01" And b = 11) Or a = "02" Or a = "03" Or a = "04" Or a = "05" Or a = "06" Or a = "07" Or a = "08" Then
                    [COLOR=#ff0000]Cll[/COLOR].Interior.ColorIndex = 0
                    Exit Sub
                Else
                    MsgBox ("So DT sai. Kiem tra lai. Neu dung thi nho ghi chu")
                    [COLOR=#ff0000]Cll[/COLOR].Interior.ColorIndex = 3
                End If
            [COLOR=#ff0000]Next[/COLOR]
        End If
    End With
End Sub

 

[redosolo]

Nó vẫn bị trước cột D, tức là bây giờ nó chỉ tô đỏ 3 cột A,B,C bạn ơi.

 

[redosolo]

Lỗi này cũng xảy ra khi mình xài format painter nữa bạn.

 

[namhn_vn]

Mình có file này. Nếu nhập liệu từ chính file thì ko sao, nhưng khi copy và paste vào file thì nó tự động tính là WorkSheet_change.
Theo như trong file thì khi đánh sai số DT thì nó sẽ tô đỏ ô đó ở cột D, nhưng khi mình copy dữ liệu từ 1 file khác vào thì nó sẽ tô đỏ tất cả những dữ liệu được copy.
Mình không bít cách làm sao để khắc phục vấn đề đó. Các bạn coi file đính kèm giùm mình nha.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next


With Range("D")
If Not Intersect(Target, .Cells) Is Nothing Then
Dim a, b, c, d, e


Dim Cll As Range


a = Left(Target, 2)
b = Len(Target)
If (a = "09" And b = 10) Or (a = "01" And b = 11) Or a = "02" Or a = "03" Or a = "04" Or a = "05" Or a = "06" Or a = "07" Or a = "08" Then
Target.Interior.ColorIndex = 0
Exit Sub
Else
If IsArray(Target) Then
MsgBox ("So DT sai. Kiem tra lai. Neu dung thi nho ghi chu")
For Each Cll In Target
d = Left(Cll, 2)
e = Len(Cll)
If (d = "09" And e = 10) Or (d = "01" And e = 11) Or d = "02" Or e = "03" Or d = "04" Or e = "05" Or d = "06" Or d = "07" Or d = "08" Then
Cll.Interior.ColorIndex = 0
Else
Cll.Interior.ColorIndex = 3
End If
Next
Else
If Target <> 0 Then
MsgBox ("So DT sai. Kiem tra lai. Neu dung thi nho ghi chu")
Target.Interior.ColorIndex = 3
Else
Target.Interior.ColorIndex = 0
End If
End If

End If
End If
End With
End Sub

 

[redosolo]

Nó vẫn bị như vậy bạn à.
Nhập liệu chính trong file thì ko sao, nhưng nếu copy paste từ file khác, hoặc Format Painter từ trên xuống, là nó tô đỏ hết.

 

[ptm0412]

Sự kiện Format cells (bao gồm format bằng format painter) không được coi là sự kiện để chạy thủ tục Worksheet_Change

 

[redosolo]

Nhưng khi mình format painter mà chọn nguyên dòng, thì nó cũng tính là Worksheet_Change, kể cả khi mình copy từ file khác vào.

 

[le tin]

Nhưng khi mình format painter mà chọn nguyên dòng, thì nó cũng tính là Worksheet_Change, kể cả khi mình copy từ file khác vào.

Bạn thêm vào dòng này xem sao
If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then

 

[ptm0412]

Tôi xem lại code nghiaphuc thì bạn đúng. Bạn sửa như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range
    [COLOR=#ff0000]'On Error Resume Next 'Bỏ câu này, và thêm điều kiện Cll không rỗng[/COLOR]
    With Range("D:D")
        If Not Intersect(Target, .Cells) Is Nothing Then
            Dim a, b, c
            For Each Cll In Target
                b = Len(Cll)
[COLOR=#ff0000]            If b > 1 Then[/COLOR]
                a = Left(Cll, 2)
                If (a = "09" And b = 10) Or (a = "01" And b = 11) _
                    Or a = "02" Or a = "03" Or a = "04" Or a = "05" Or a = "06" _
                    Or a = "07" Or a = "08" Then
                    Cll.Interior.ColorIndex = 0
                    [COLOR=#ff0000]' Exit Sub ' Bỏ câu này[/COLOR]
                Else
                    MsgBox ("So DT sai. Kiem tra lai. Neu dung thi nho ghi chu")
                    Cll.Interior.ColorIndex = 3
                End If
           [COLOR=#ff0000] End If[/COLOR]
            Next
        End If
    End With
End Sub

 

[ptm0412]

Bạn thêm vào dòng này xem sao
If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then

Khi copy và Paste thì Target.Count có thể lớn hơn 1, anh LeTin ạ.

 

[redosolo]

Copy và format painter vẫn bị như thế bạn ơi. Chỉ khác cái là bây giờ nó sẽ tô đỏ những ô có dữ liệu.

 

[redosolo]

Bạn thêm vào dòng này xem sao
If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then

Làm như vậy thì ko thấy lỗi như vậy nữa.
Tks bạn.

 

[Let'GâuGâu]

Làm như vậy thì ko thấy lỗi như vậy nữa.
Tks bạn.

bạn thử cố tình copy 2 -3 dòng vào (có số sai vào xem nó có phát hiện được ko)?

 

[redosolo]

bạn thử cố tình copy 2 -3 dòng vào (có số sai vào xem nó có phát hiện được ko)?

đúng như bạn nói. khi copy 2 - 3 dòng mà có số sai thì nó lại không phát hiện được

 

[redosolo]

[GPECODE]Private Sub Worksheet_Change(ByVal Target As Range)
Dim cll As Range
Dim onlyThese As Range
Dim celltoUse As Range
On Error GoTo Whoa
Application.EnableEvents = False


Set onlyThese = Range("D")
Set celltoUse = Intersect(onlyThese, Target)
If celltoUse Is Nothing Then GoTo letscontinue
Dim a, b, c


For Each cll In celltoUse
b = Len(cll)
a = Left(cll, 2)
If (a = "09" And b = 10) Or (a = "01" And b = 11) Or a = "02" Or a = "03" Or a = "04" Or a = "05" Or a = "06" Or a = "07" Or a = "08" Then
cll.Interior.ColorIndex = 0
'Exit Sub
Else
MsgBox ("So DT sai. Kiem tra lai. Neu dung thi nho ghi chu")
cll.Interior.ColorIndex = 3
End If
Next
letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
Resume letscontinue
End Sub
[/GPECODE]
Mình đã sửa được rồi. Theo như code này thì cả khi copy lẫn Format Painter thì đều check số DT sai.
Tks các bạn đã giúp đỡ nha.

 

[ptm0412]

Copy và format painter vẫn bị như thế bạn ơi. Chỉ khác cái là bây giờ nó sẽ tô đỏ những ô có dữ liệu.

Bạn đang nói code nào? Code bài #10 tôi đã test bằng cách copy, format painter 1 ô, nhiều ô và đúng.

Code của bạn bài 16 không loại trừ trường hợp ô trống, nên nếu xóa ô, hoặc nếu dùng format painter cho ô trống, nó cũng bị đỏ.
Phần còn lại so với code bài #10 đâu có khác gì?

 

[le tin]

... Code bài #10 tôi đã test bằng cách copy, format painter 1 ô, nhiều ô và đúng.

Code này tôi thử thấy chưa ổn(copy-paste) như sau:
- Các cột khác sẽ bị tô đỏ (khi <>"")
- Dữ liệu = 1 thì không báo lỗi (vì điều kiện là b>1 )
- Khi ô đã bị tô đỏ .Xóa dữ liệu nó vẫn còn đỏ
Trên cơ sở code đó tôi chỉnh lại :
.....
If Cll.Column = 4 Then
If Cll <> "" Then
b = Len(Cll)
a = Left(Cll, 2)
If ...
...
...
End If
Else
Cll.Interior.ColorIndex = 0
End If
End If
......
Thân chào

 

[redosolo]

Bạn đang nói code nào? Code bài #10 tôi đã test bằng cách copy, format painter 1 ô, nhiều ô và đúng.

Code của bạn bài 16 không loại trừ trường hợp ô trống, nên nếu xóa ô, hoặc nếu dùng format painter cho ô trống, nó cũng bị đỏ.
Phần còn lại so với code bài #10 đâu có khác gì?

Code bài #16 mình đã test rồi mà.
Khi xóa đi nó vẫn báo, vẫn tô đỏ mà.

 

[ptm0412]

Code này tôi thử thấy chưa ổn(copy-paste) như sau:
- Các cột khác sẽ bị tô đỏ (khi <>"")
- Dữ liệu = 1 thì không báo lỗi (vì điều kiện là b>1 )
- Khi ô đã bị tô đỏ .Xóa dữ liệu nó vẫn còn đỏ
Thân chào

Cám ơn anh LeTin. Đúng là tôi sót 1 cái Else nên xóa ô có màu sẽ không xóa cả màu. Tuy nhiên tôi không thấy lỗi tô màu cột khác?

Thêm Else như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cll As Range
    With Range("D:D")
        If Not Intersect(Target, .Cells) Is Nothing Then
            Dim a, b
            For Each cll In Target
                b = Len(cll)
            If b > 0 Then
                a = Left(cll, 2)
                If (a = "09" And b = 10) Or (a = "01" And b = 11) _
                    Or a = "02" Or a = "03" Or a = "04" Or a = "05" Or a = "06" _
                    Or a = "07" Or a = "08" Then
                    cll.Interior.ColorIndex = 0
                Else
                    cll.Interior.ColorIndex = 3
                End If
            [COLOR=#ff0000]Else
                cll.Interior.ColorIndex = 0[/COLOR]
            End If
            Next
        End If
    End With
End Sub

 

[le tin]

Mình cho ví dụ :
C20= 8
Copy C2021
Paste vào C2223
C22 sẽ tô đỏ

 

[ptm0412]

Mình cho ví dụ :
C20= 8
Copy C2021
Paste vào C2223
C22 sẽ tô đỏ

Trường hợp này tôi không nghĩ tới. Vì theo bảng dữ liệu thì tôi nghĩ tác giả chỉ copy số điện thoại từ sheet khác hoặc file khác và paste vào cột D.
Như vậy code của anh LeTin sẽ loại các Cll paste đồng thời nhưng không phải cột D.

 

[le tin]

Ở bài 3 thấy tác giả có đề cập đến các cột khác . Cũng hợp lý vì có khi copy 1 vùng dữ liệu