Sửa code

[thanh tong]

Các bạn xem hộ mình xem code sau sai ở đâu?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As Integer
For n = 1 To 100
If Target.Row = n And Not IsEmpty(Target) And Selection.Count = 1 Then
If Application.CountIf(Rows(n), Trim(Right(Target.Value, Len(Target.Value) - Application.Find("-", Target.Value)))) > 1 Then
Target.ClearContents
Target.Select
Else
Exit Sub
End If

End If
Next
End Sub

Cảm ơn các bạn

 

[ptm0412]

Giả sử dữ liệu cần dò tìm trùng là cột D từ dòng 3 trở xuống.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D3:D100")) Is Nothing Then
     If Not IsEmpty(Target) And Selection.Count = 1 Then
        If Application.CountIf(Range("D3:D" & Target.Row), Target.Value) > 1 Then
            Target.ClearContents
            Target.Select
        End If
     End If
End If
End Sub

 

[sealand]

Bạn thử như sau để không chế các cột A,B,D,E,F và từ dòng 2 đến dòng 8 nha:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Rng = Application.Union(Sheet1.[A2:B8], Sheet1.[D2:F8])
If Not Intersect(Target, Rng) Is Nothing Then
If Not IsEmpty(Target) And Selection.Count = 1 Then
If Application.CountIf(Rows(Target.Row), Target.Value) > 1 Then
Target.ClearContents
Target.Select
Else
Exit Sub
End If
End If
End If
End Sub

 

[TrungChinhs]

Bạn thử code này xem. Chú ý khi nhập dữ liệu thì nhấn Enter để kết thúc.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [b2:j20]) Is Nothing Then
        Application.MoveAfterReturn = 0
        If Application.CountIf(Cells(Target.Row, 2).Resize(, 10), Target) > 1 Then Target.ClearContents
    End If
    If Intersect(Target, [b2:j20]) Is Nothing Then Application.MoveAfterReturn = 1
End Sub

 

[thanh tong]

Bạn thử code này xem. Chú ý khi nhập dữ liệu thì nhấn Enter để kết thúc.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [b2:j20]) Is Nothing Then
        Application.MoveAfterReturn = 0
        If Application.CountIf(Cells(Target.Row, 2).Resize(, 10), Target) > 1 Then Target.ClearContents
    End If
    If Intersect(Target, [b2:j20]) Is Nothing Then Application.MoveAfterReturn = 1
End Sub

Sao mình thử File của câu không thấy được vậy?

 

[TrungChinhs]

Sao mình thử File của câu không thấy được vậy?

Tôi tải về thử lại vẫn được mà. Lúc trước xem bài chưa sửa thấy bạn yêu cầu xóa số trùng mới nhập trên cùng 1 dòng đúng không ? bạn vào vùng trong khung nhập một số nào đó trùng với số đã có trước rồi nhấn Enter xem có được không. Chú ý là phải kết thúc bằng fím Enter nha.

 

[ptm0412]

Bài 1 đã bị edit lại. Trước khi edit có ghi yêu cầu (không rõ ràng lắm), và mình cho rằng khống chế không cho trùng dữ liệu theo cột. Sau khi edit thì mất tiêu yêu cầu, và mọi người lại cho rằng trùng theo dòng.

Vậy thì 3 bài trả lời trở nên vô ích và vô nghĩa.

 

[thanh tong]

Tôi xin lỗi các bạn vì lúc đó tôi vừa thấy các bạn trả lời xong nên tôi định hỏi luôn vì bài trước tôi cũng tham khảo được rồi nên tôi không muốn làm thêm đề tài khác mà tiện đấy có các bạn đang giúp thì tôi sửa luôn bài cũ, có gì sai mong các bạn thông cảm và bỏ qua cho
Tôi cũng hay vào diễn đàn để tham khảo, học hỏi nhiều lúc thấy các bạn đang trong điễn đàn nhưng không liên lạc trực tiếp được.