Giúp em xóa dữ liệu dùng VBA theo điều kiện

[Long Lee Trung]

000ab-123ccd-gg567-ee123-xxx3​

tic00-1m23v-vyy13-0kilo-2helos​

000cd-img90-0090z-cd123​

2000a-783m1-viwdf0-exwwl​

0123t-0tt000-0983j-222lm​

anh chị cho em hỏi là có hàm vba nào có thể xóa được hàng theo điềukiện là : chỉ xóa những dòng mà trong đó có kí tự "000" và "123" (không cần biết vị trí), theo kết quả thì sẽ xóa được dòng 1-3-5 ?

có hàm vba này nhưng chỉ xóa được 1 chuỗi kí tự :
Sub DeleteRows()

Dim c As Range

Dim SrchRng

Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp))

Do

Set c = SrchRng.Find("000", LookIn:=xlValues)

If Not c Is Nothing Then c.EntireRow.Delete

Loop While Not c Is Nothing

End Sub

 

[HieuCD]

Lô đề thì em không rõ, còn nói về dữ liệu giả sử 1-1-1-1-2 thì điều kiện vậy đâu có xóa được dòng này đâu bác? theo em sửa s thành s="-" & du_lieu(i, 1) & "-"

Chuẩn rồi

Theo mình thì vòng for như này sẽ gọn hơn:

For i = 1 To r
        txt = du_lieu(i, 1) 'dua len vong for1, giam so lan gán
        If txt <> "" Then
            For n = 0 To x
                str = dieu_kien(n)
                    If InStr(txt, str) Then Exit For
                    If n = x Then
                    k = k + 1
                    du_lieu(k, 1) = du_lieu(i, 1)
                    End If
            Next n
        End If
    Next i

Đem
If n = x Then
k = k + 1
du_lieu(k, 1) = du_lieu(i, 1)
End If
ra ngoài vòng "For n = 0 To x" sẽ chạy nhanh hơn

 

[Long Lee Trung]

OT chạy code "Loi_Khong_Xoa_Duoc" thì bị lỗi: Cannot use that command on overlapping selections.
tại dòng: sheet.Range(txt).Delete shift:=xlUp
Nhờ các Bạn xem giúp ạ:

Public Sub Loi_Khong_Xoa_Duoc()

    Dim sheet As Worksheet, dieu_kien(), du_lieu(), r As Long
    Set sheet = ThisWorkbook.Worksheets("Sheet1")
    r = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).Row
    If r = 1 Then GoTo End_
    du_lieu = sheet.Range("A1").Resize(r).Value2
    dieu_kien = Array(2, 4) ' <---  nhap dieu kien can xoa
 
    Dim a(), str$, txt$, i&, k&, n&
    For i = 1 To r
        For n = 0 To UBound(dieu_kien)
            str = "*" & dieu_kien(n) & "*"
            If du_lieu(i, 1) Like str Then
                If Len(txt) = 0 Then
                    txt = "A" & i
                ElseIf Len(txt) < 55 Then
                    txt = txt & "," & "A" & i
                Else
                    k = k + 1
                    ReDim Preserve a(1 To k)
                    a(k) = txt: txt = Empty
                End If
            End If
        Next n
    Next i

    If k = 0 Then GoTo End_
    For i = k To 1 Step -1
        txt = a(i)
        sheet.Range(txt).Delete shift:=xlUp 'Error:Cannot use that command on overlapping selections.
    Next i
    MsgBox "Da xong!", vbInformation
End_:

End Sub

Các dòng đó OT đặt câu hỏi là là để muốn xác nhận với Bạn, nhưng Bạn không cho biết là có đúng hay là không?
Bạn chạy thử đoạn bên dưới xem được không ạ?

Option Explicit

Public Sub sao_xoa_nhieu_vay()
    Dim sheet As Worksheet, dieu_kien(), du_lieu(), r As Long
    Set sheet = ThisWorkbook.Worksheets("Sheet1")
    r = sheet.Cells(sheet.Rows.Count, "A").End(xlUp).Row
    If r = 1 Then Exit Sub
    du_lieu = sheet.Range("A1").Resize(r).Value2
    dieu_kien = Array(2, 4) '<---  nhap dieu kien can xoa
    Dim a(), str$, txt$, i&, k&, n&
    For i = 1 To r
        For n = 0 To UBound(dieu_kien)
            str = "*" & dieu_kien(n) & "*"
            txt = du_lieu(i, 1)
            If Len(txt) > 0 Then
                If txt Like str Then
                    Exit For
                Else
                    k = k + 1
                    du_lieu(k, 1) = du_lieu(i, 1)
                    Exit For
                End If
            End If
        Next n
    Next i
    sheet.Range("A1").Resize(r).ClearContents
    If k = 0 Then Exit Sub
    sheet.Range("A1").Resize(k).Value = du_lieu
    MsgBox "Da xong!", vbInformation
End Sub

sau khi test thì đoạn này chạy phù hợp và chính xác nhất đối với yêu cầu của em @@

 

[Hoàng Tuấn 868]

Bài này mà có thêm lời cảm ơn với những người đã giúp thì hoàn hảo.

 

[VetMini]

Bai này mà có thêm lời cảm ơn với những người đã giúp thì hoàn hảo.

Qua bài #42, thớt đã xác định cái nào đúng nhất rồi. Đâu cần phải cám ơn.

 

[Long Lee Trung]

cảm ơn mọi người giúp đỡ em @@..do đi làm nên ít có thời gian onl đó ạ

 

[VetMini]

@ Bạn ở bài #43:
Nghe Tây đã chưa? Tôi cản bạn hỏng kịp.

 

[Hoàng Tuấn 868]

@ Bạn ở bài #43:
Nghe Tây đã chưa? Tôi cản bạn hỏng kịp.

Phục anh đoán được vụ nói tiếng Tây bồi này chứ em thì chịu hẳn.

 

[VetMini]

Phục anh đoán được vụ nói tiếng Tây bồi này chứ em thì chịu hẳn.

Thấy trước ở đây rồi mà:

trước tiên là em cảm ơn đã rep @@. ...

ah dữ liệu number và text thì trích xuất khác nhau ạ? @@ a xử lý giúp e ...

dạ oke rồi anh,,vấn đề của e đã được giải quyết..a có thể cho em stk ko..e gửi ít a uống nước ạ. (cho em xin zalo hoặc face được ko @@)