Code Xoá theo điều kiện của sheet1 (1 người xem)

[tanthanh94]

Chào các anh
nếu các dữ liệu trong cột A sheet1 trùng với cột A Sheet2 thì xóa các giá trị các dòng từ cột B
như trong file mình có 3 dữ liệu trùng nhau S9591,D9028,A9028 và kết quả muốn xóa dòng B55,B77,B1010

 

[phihndhsp]

muốn xóa những ô màu vàng trong 1 cột bạn làm như sau
B1:Fillter theo màu
B2:Chọn goto speacial -> chọn visible ->
B3:Ra ngoài nhấn nút clear contents là ok

 

[tanthanh94]

muốn xóa những ô màu vàng trong 1 cột bạn làm như sau
B1:Fillter theo màu
B2:Chọn goto speacial -> chọn visible ->
B3:Ra ngoài nhấn nút clear contents là ok

ô tô màu vàng của sheet2 là kết quả mình muốn xóa dựa theo điều kiện của sheet1

 

[comet_1701]

Chào các anh
Nếu các mã trong cột A sheet1 trùng với cột A sheet2
thì xóa dữ liệu các dòng mình tô màu vàng trong sheet2 theo file đính kèm.

Sub xoadong()
Dim Rng As Range, Rng1 As Range, cll As Range
Set Rng = Sheet1.Range("A4:A" & Sheet1.Range("A65000").End(xlUp).Row)
Set Rng1 = Sheet2.Range("A5:A" & Sheet2.Range("A65000").End(xlUp).Row)
For Each cll In Rng1
    If Application.CountIf(Rng, cll) = 1 Then
        cll.EntireRow.Delete
    End If
Next
Set Rng = Nothing
Set Rng1 = Nothing
        
End Sub

Bạn thử xem sao,
Muốn ko xóa cột B thì sửa lại chút thôi

cll.Offset(, 1).Resize(, 25).ClearContents

 

[tanthanh94]

Sub xoadong()
Dim Rng As Range, Rng1 As Range, cll As Range
Set Rng = Sheet1.Range("A4:A" & Sheet1.Range("A65000").End(xlUp).Row)
Set Rng1 = Sheet2.Range("A5:A" & Sheet2.Range("A65000").End(xlUp).Row)
For Each cll In Rng1
    If Application.CountIf(Rng, cll) = 1 Then
        cll.EntireRow.Delete
    End If
Next
Set Rng = Nothing
Set Rng1 = Nothing
        
End Sub

Bạn thử xem sao,

ý của mình xóa như vậy nhưng không muốn mất dữ liệu cột B
Mình bổ sung thêm phần màu đỏ từ code anh Ba TÊ

Private Sub CommandButton1_Click()
Dim Dic As Object, sArr(), tArr(1 To 1000, 1 To 1), dArr(1 To 1000, 1 To 1)
Dim I As Long, K As Long, C As Long, Tem As String
Dim Rng As Range, Clls As Range
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([A5], [A65536].End(xlUp)).Value
C = [IV4].End(xlToLeft).Column
For I = 1 To UBound(sArr, 1)
    K = K + 1
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then Dic.Add Tem, K
    tArr(I, 1) = sArr(I, 1)
Next I
With Sheet1
    sArr = .Range(.[A4], .[B65536].End(xlUp)).Value
End With
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Dic.Exists(Tem) Then
        dArr(Dic.Item(Tem), 1) = sArr(I, 2)
    Else
        K = K + 1
        tArr(K, 1) = sArr(I, 1)
        dArr(K, 1) = sArr(I, 2)
    End If
Next I
[A5].Resize(K) = tArr
[COLOR=#ff0000][A5].Offset(, 1).Resize(K).Value = dArr
Set Rng = Sheet2.Range("B5:B5000")
For Each Clls In Rng
    If Clls.Value <> Empty Then
        Clls.Resize(, 25).ClearContents[/COLOR]
    End If
    Next
Set Dic = Nothing


End Sub

 

[giangleloi]

ý của mình xóa như vậy nhưng không muốn mất dữ liệu cột B
Mình bổ sung thêm phần màu đỏ từ code anh Ba TÊ

Bạn muốn gì thì ngay từ lúc đầu hỏi. Hãy nêu hết ra để người giúp bạn khỏi phải mất công mất sức. Và nếu là tiếp của bài trước thì phải có liên kết với nhau. Đằng này chẳng thấy đầu đuôi đâu cả.

 

[tanthanh94]

Bạn muốn gì thì ngay từ lúc đầu hỏi. Hãy nêu hết ra để người giúp bạn khỏi phải mất công mất sức. Và nếu là tiếp của bài trước thì phải có liên kết với nhau. Đằng này chẳng thấy đầu đuôi đâu cả.

- ý của mình là nếu các dữ liệu trong cột A sheet1 trùng với cột A Sheet2 thì xóa các giá trị các dòng từ cột B
như trong file mình có 3 dữ liệu trùng nhau S9591,D9028,A9028 và kết quả muốn xóa dòng B55,B77,B1010
Còn nếu tận dụng code trên thì mình phải insert thêm 1 cột nữa.
Cùng 1 file cũ nhưng điều kiện khác nên mình mới tạo tiêu đề mới.
Cám ơn bạn.

 

[tanthanh94]

Ý mình tương tư như bài này nhưng muốn dữ lại tên code của cột A
http://www.giaiphapexcel.com/forum/showthread.php?65684-Xoá-dòng-theo-điều-kiện