Cần giúp viết Code Delete các dòng (Thỏa mãn điều kiện là ô đầu tiên có màu vàng) (1 người xem)

[hung2412]

Chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột A có các ô chứa ký tự được phân cách như theo hình vẽ:

Đề bài 1: Nếu ô nào ở cột A (Từ ô A6 trở xuống) có màu vàng (Ô có bất kỳ ký tự nào, không phải ô trống) thì: Delete các dòng tính từ dòng chứa ô có màu vàng đó đến xuống dòng kế bên trên dòng chứa ô có ký tự ở dưới.
Ví dụ: ô A12 có màu vàng và có chứa ký tự => Thỏa mãn điều kiện để Delete => Delete các dòng từ dòng 12 (Dòng này chứa ô A12) đến dòng 19 (Dòng này nằm ngay kế bên trên ô A20 có chứa ký tự).
Đề bài 2: Như Đề bài 1 nhưng ô trống (Màu vàng, không chứa ký tự).
Đề bài 3: Như Đề bài 1 nhưng ô có màu tím (Ô có bất kỳ ký tự nào, không phải là ô trống).
Đề bài 4: Như Đề bài 1 nhưng ô có màu tím (Ô không có bất kỳ ký tự nào, phải là ô trống).
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

 

[gtri]

Chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột A có các ô chứa ký tự được phân cách như theo hình vẽ:
View attachment 133444
Đề bài 1: Nếu ô nào ở cột A (Từ ô A6 trở xuống) có màu vàng (Ô có bất kỳ ký tự nào, không phải ô trống) thì: Delete các dòng tính từ dòng chứa ô có màu vàng đó đến xuống dòng kế bên trên dòng chứa ô có ký tự ở dưới.
Ví dụ: ô A12 có màu vàng và có chứa ký tự => Thỏa mãn điều kiện để Delete => Delete các dòng từ dòng 12 (Dòng này chứa ô A12) đến dòng 19 (Dòng này nằm ngay kế bên trên ô A20 có chứa ký tự).
Đề bài 2: Như Đề bài 1 nhưng ô trống (Màu vàng, không chứa ký tự).
Đề bài 3: Như Đề bài 1 nhưng ô có màu tím (Ô có bất kỳ ký tự nào, không phải là ô trống).
Đề bài 4: Như Đề bài 1 nhưng ô có màu tím (Ô không có bất kỳ ký tự nào, phải là ô trống).
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Thử code này xem sao
(Nếu muốn màu khác thì chỉnh lại số liệu của colr1 hoặc colr2)

Public Sub Xoa_Dong_Theo_Mau_Sac()
Dim Colr1, Colr2, r As Long, rw As Long
Colr1 = 6
Colr2 = 46

With Sheet1
For r = 6 To .Range("A65000").End(3).Row
If .Range("A" & r).Interior.ColorIndex = Colr1 Or .Range("A" & r).Interior.ColorIndex = Colr2 Then
rw = r + 1
Do While .Range("A" & rw).Value = ""
rw = rw + 1
Loop
.Range("A" & r, "A" & rw - 1).EntireRow.Delete
End If
Next r
End With

End Sub

 

[mhung12005]

Chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Dọc theo cột A có các ô chứa ký tự được phân cách như theo hình vẽ:
View attachment 133444
Đề bài 1: Nếu ô nào ở cột A (Từ ô A6 trở xuống) có màu vàng (Ô có bất kỳ ký tự nào, không phải ô trống) thì: Delete các dòng tính từ dòng chứa ô có màu vàng đó đến xuống dòng kế bên trên dòng chứa ô có ký tự ở dưới.
Ví dụ: ô A12 có màu vàng và có chứa ký tự => Thỏa mãn điều kiện để Delete => Delete các dòng từ dòng 12 (Dòng này chứa ô A12) đến dòng 19 (Dòng này nằm ngay kế bên trên ô A20 có chứa ký tự).
Đề bài 2: Như Đề bài 1 nhưng ô trống (Màu vàng, không chứa ký tự).
Đề bài 3: Như Đề bài 1 nhưng ô có màu tím (Ô có bất kỳ ký tự nào, không phải là ô trống).
Đề bài 4: Như Đề bài 1 nhưng ô có màu tím (Ô không có bất kỳ ký tự nào, phải là ô trống).
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Một cách để bạn tham khảo:

Sub DeleteRow()    
    Dim rSrcRng As Range
    Dim lLastRow As Long, lEndRow As Long, lR As Long, i As Long
    
    lLastRow = Sheet1.Range("C65000").End(xlUp).Row
    Set rSrcRng = Sheet1.Range("A6:A" & lLastRow)
    
    For lR = lLastRow To 6 Step -1
        If Len(Cells(lR, 1)) Then
            If Cells(lR, 1).Interior.Color = 65535 Then
                For i = lR + 1 To lLastRow
                    If Len(Cells(i, 1)) Then
                        lEndRow = i - 1
                        Exit For
                    ElseIf i = lLastRow Then
                        lEndRow = i
                    End If
                Next i
                Sheet1.Range(Cells(lR, 1), Cells(lEndRow, 1)).EntireRow.Delete
            End If
        End If
    Next lR
    
End Sub

 

[hung2412]

Có Code nào duyệt trực tiếp các ô có màu (Nhảy cóc như kiểu dùng Find()) không nhỉ? => Delete luôn các dòng => Không phải duyệt từng ô.

 

[ChanhTQ@]

Có Code nào duyệt trực tiếp các ô có màu (Nhảy cóc như kiểu dùng Find()) không nhỉ? => Delete luôn các dòng => Không phải duyệt từng ô.

Cái ni nhảy cóc nè, mại zô:

Option Explicit
Sub DelecteColorCells()
 Dim Rng As Range, Cls As Range, dRg As Range
 
 Set Cls = [D65500].End(xlUp).Offset(, -3)
 Cls.Value = "GPE.COM"
 Set dRg = Rows(Cls.Row + 9 & ":" & Cls.Row + 9)
 Set Rng = Range([A6], Cls).SpecialCells(xlCellTypeConstants, 2)
 For Each Cls In Rng
    If Cls.Interior.ColorIndex = 6 Then
        Set dRg = Union(Rows(Cls.Row & ":" & Cls.End(xlDown).Offset(-1).Row), dRg)
    End If
 Next Cls
 dRg.Delete
End Sub

 

[hung2412]

Cái ni nhảy cóc nè, mại zô:

Option Explicit
Sub DelecteColorCells()
 Dim Rng As Range, Cls As Range, dRg As Range
 Set Cls = [D65500].End(xlUp).Offset(, -3)
 Cls.Value = "GPE.COM"
 Set dRg = Rows(Cls.Row + 9 & ":" & Cls.Row + 9)
 Set Rng = Range([A6], Cls).SpecialCells(xlCellTypeConstants, 2)
 For Each Cls In Rng
    If Cls.Interior.ColorIndex = 6 Then
        Set dRg = Union(Rows(Cls.Row & ":" & Cls.End(xlDown).Offset(-1).Row), dRg)
    End If
 Next Cls
 dRg.Delete
End Sub

Bạn thường hay cho thêm dòng này vào trong Code nhỉ?

 Cls.Value = "GPE.COM"