Cảnh báo khi nhập dữ liệu trùng trong vùng fillter

[huutinh85]

mình có 1 bảng phân công đứng máy,mối người trong 1 bộ phận phụ trách nhiều máy, số máy khong giới hạn. Khi mình chọn tên bộ phận ở B4 VÀ Click "PC DUNG MAY" thì sẽ fill ra từng BP. Nhập pc cho từng người, khi minh nhập trùng máy trong cùng 1 bộ phận thì sẽ xuất hiện cảnh báo máy đã pc., nếu khác bộ phận thì trùng cũng không sao cả. Mình đã tham khảo code của 1 bác trên diễn đàn nhưng code này áp cụng cho toàn vùng nên mình ko biết làm thế nào để áp dụng riêng cho phần fillter mà ko ảnh hưởng vùng khác. Mong các bác chỉ giáo!

 

[leonguyenz]

Thử code này xem:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lr As Long, i As Long, j As Long, Tmp As String
Lr = Range("A" & Rows.Count).End(xlUp).Row
If Target.Address = "$B$4" Then
    Range("A6:S" & Lr).AutoFilter 2, Range("B4").Value
ElseIf Not Intersect(Target, Range("D7:S" & Lr)) Is Nothing Then
    If Target.Count = 1 Then
        For i = 1 To Lr - 6
            If Cells(i + 6, 2).Value = Range("B4").Value Then
                For j = 1 To 16
                    Tmp = UCase(Cells(i + 6, j + 3).Value)
                    If Tmp = UCase(Target.Value) And _
                        Target.Value <> "" And _
                        Cells(i + 6, j + 3).Address <> _
                        Target.Address Then
                        MsgBox "Trùng PC máy " & Cells(i + 6, j + 3).Value
                    End If
                Next j
            End If
        Next i
    End If
End If
End Sub

Chọn B4 để Filter.

 

[tieuthubuongbinh]

@huutinh85 thành viên lâu năm mà ko biế viết tiêu đề in hoa hết như vậy là phạm quy à?
Bạn chú ý chỉnh tiêu đề lại cho phù hợp nội quy diễn đàn
@leonguyenz
Giúp cũng nên nhắc việc này chứ anh

 

[huutinh85]

Thử code này xem:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lr As Long, i As Long, j As Long, Tmp As String
Lr = Range("A" & Rows.Count).End(xlUp).Row
If Target.Address = "$B$4" Then
    Range("A6:S" & Lr).AutoFilter 2, Range("B4").Value
ElseIf Not Intersect(Target, Range("D7:S" & Lr)) Is Nothing Then
    If Target.Count = 1 Then
        For i = 1 To Lr - 6
            If Cells(i + 6, 2).Value = Range("B4").Value Then
                For j = 1 To 16
                    Tmp = UCase(Cells(i + 6, j + 3).Value)
                    If Tmp = UCase(Target.Value) And _
                        Target.Value <> "" And _
                        Cells(i + 6, j + 3).Address <> _
                        Target.Address Then
                        MsgBox "Trùng PC máy " & Cells(i + 6, j + 3).Value
                    End If
                Next j
            End If
        Next i
    End If
End If
End Sub

Chọn B4 để Filter.

Dạ cảm ơn bác rất nhiều ạ. giờ e muốn sau khi cảnh báo thì dữ liệu trùng tại cell vừ điền đó bị xóa đi thì e thêm câu lệnh sau mgsbox là: target.clearcontents thấy ok. đượckhông bác

 

[leonguyenz]

Dạ cảm ơn bác rất nhiều ạ. giờ e muốn sau khi cảnh báo thì dữ liệu trùng tại cell vừ điền đó bị xóa đi thì e thêm câu lệnh sau mgsbox là: target.clearcontents thấy ok. đượckhông bác

Được bạn, mà cứ thử được thì làm thôi.
Chúc vui!

 

[tieuthubuongbinh]

Được bạn, mà cứ thử được thì làm thôi.
Chúc vui!

Thành viên này rất có tâm với GPE, anh giúp cho đến nơi đến chốn nhá nhá

 

[huutinh85]

Được bạn, mà cứ thử được thì làm thôi.
Chúc vui!

mình mới tìm hiểu code vba nên đang mù mờ, hy vọng đươc bạn và a chị e hỗ trợ, giup đỡ. cảm ơn các bạn rất nhiều!