Xóa dữ liệu có cùng điều kiện

[lp0072021]

Chào Anh/Chị.
Nhờ anh chị viết giúp em code để khi xóa dữ liệu của một ô trong cột D, tham chiếu mã của ô đó ở cột F nếu các ô còn lại ở cột D có cùng mã thì dữ liệu cũng được xóa. Em cảm ơn các anh chị ạ.

 

[snow25]

Chào Anh/Chị.
Nhờ anh chị viết giúp em code để khi xóa dữ liệu của một ô trong cột D, tham chiếu mã của ô đó ở cột F nếu các ô còn lại ở cột D có cùng mã thì dữ liệu cũng được xóa. Em cảm ơn các anh chị ạ.

Xóa ở cột D thế có xóa dữ liệu ở cột E không.Mà bạn đưa kết quả khi xóa lên.Code xong ai biết đúng sai thế nào.

 

[lp0072021]

Xóa ở cột D thế có xóa dữ liệu ở cột E không.Mà bạn đưa kết quả khi xóa lên.Code xong ai biết đúng sai thế nào.

Chỉ xóa cột D thôi bạn nhé, mình đã gửi lại file có kết quả rồi. bạn xem giúp mình với nhé.

 

[snow25]

Chỉ xóa cột D thôi bạn nhé, mình đã gửi lại file có kết quả rồi. bạn xem giúp mình với nhé.

File đâu ta không thấy.

 

[lp0072021]

File đâu ta không thấy.

Xin lỗi bạn nhé, mình mới gửi lại

 

[Nhattanktnn]

File đâu ta không thấy.

Bài này sau khi có file chắc cũng phải tới bài #10 mới có kết quả

 

[snow25]

Xin lỗi bạn nhé, mình mới gửi lại

Thử code hên sui.

Sub abc()
    Dim arr, dic As Object, i As Long, j As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        arr = .Range("D7:F17").Value
        For i = 1 To UBound(arr)
            dk = arr(i, 3)
            If Not dic.exists(dk) Then
                dic.Add dk, i
            Else
                arr(dic.Item(dk), 1) = Empty
                arr(i, 1) = Empty
            End If
        Next i
        .Range("D7:F17").Value = arr
    End With
    Set dic = Nothing
End Sub

Bài này sau khi có file chắc cũng phải tới bài #10 mới có kết quả

Bài 10 cũng chưa xong nhé.

 

[lp0072021]

Thử code hên sui.

Sub abc()
    Dim arr, dic As Object, i As Long, j As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        arr = .Range("D7:F17").Value
        For i = 1 To UBound(arr)
            dk = arr(i, 3)
            If Not dic.exists(dk) Then
                dic.Add dk, i
            Else
                arr(dic.Item(dk), 1) = Empty
                arr(i, 1) = Empty
            End If
        Next i
        .Range("D7:F17").Value = arr
    End With
    Set dic = Nothing
End Sub

Bài 10 cũng chưa xong nhé.

Mình thử rồi thấy nó xóa tất cả những ô có trùng nhau, còn để lại ô không có mã trùng. Còn của mình muốn chỉ xóa 1 ô nào đó bất kỳ ở cột D, tham chiếu ô còn lại của cột D có cùng mã ở cột F thì xóa, nếu không cùng mã thì vẫn giữ nguyên. Ví dụ xóa ô D13 tham chiếu ô D13 ở cột F có mã là "A2" thì những ô D8 và D17 có cùng mã "A2" nên bị xóa, các ô còn lại của cột D vẫn để.