Giúp em xóa dữ liệu dùng VBA theo điều kiện

Long Lee Trung · 18/3/21

000ab-123ccd-gg567-ee123-xxx3

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

000cd-img90-0090z-cd123

2000a-783m1-viwdf0-exwwl

0123t-0tt000-0983j-222lm

anh chị cho em hỏi là có hàm vba nào có thể xóa được hàng theo điềukiện là : chỉ xóa những dòng mà trong đó có kí tự "000" và "123" (không cần biết vị trí), theo kết quả thì sẽ xóa được dòng 1-3-5 ?

có hàm vba này nhưng chỉ xóa được 1 chuỗi kí 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 · 19/3/21

Long Lee Trung đã viết:
000ab-123ccd-gg567-ee123-xxx3
tic00-1m23v-vyy13-0kilo-2helos
000cd-img90-0090z-cd123
2000a-783m1-viwdf0-exwwl
0123t-0tt000-0983j-222lm

anh chị cho em hỏi là có hàm vba nào có thể xóa được hàng theo điềukiện là : chỉ xóa những dòng mà trong đó có kí tự "000" và "123" (không cần biết vị trí), theo kết quả thì sẽ xóa được dòng 1-3-5 ?

có hàm vba này nhưng chỉ xóa được 1 chuỗi kí 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

"Sub" không phải "Hàm"

Mã:

Sub DeleteRows()
  Dim eRow As Long, i As Long
 
  eRow = Range("A" & Rows.Count).End(xlUp).Row
  For i = eRow To 1 Step -1
    If InStr(1, Cells(i, "A"), "000") > 0 Then
      If InStr(1, Cells(i, "A"), "123") > 0 Then
        Cells(i, "A").EntireRow.Delete
      End If
    End If
  Next i
End Sub

huhumalu · 19/3/21

HieuCD đã viết:

"Sub" không phải "Hàm"

Mã:

Sub DeleteRows()
  Dim eRow As Long, i As Long

  eRow = Range("A" & Rows.Count).End(xlUp).Row
  For i = eRow To 1 Step -1
    If InStr(1, Cells(i, "A"), "000") > 0 Then
      If InStr(1, Cells(i, "A"), "123") > 0 Then
        Cells(i, "A").EntireRow.Delete
      End If
    End If
  Next i
End Sub

PHP:

If InStr(1, Cells(i, "A"), "000") + InStr(1, Cells(i, "A"), "123") > 0 Then

Nhưng mà điều kiện này chưa đúng lắm, nó sẽ xóa luôn cái dòng 4 vì có "2000".

HieuCD · 19/3/21

huhumalu đã viết:
PHP:

If InStr(1, Cells(i, "A"), "000") + InStr(1, Cells(i, "A"), "123") > 0 Then

Nhưng mà điều kiện này chưa đúng lắm, nó sẽ xóa luôn cái dòng 4 vì có "2000".

If InStr(1, Cells(i, "A"), "000") + InStr(1, Cells(i, "A"), "123") > 0 Then
Ở đâu ra lệnh nầy vậy ?

VetMini · 19/3/21

huhumalu đã viết:
PHP:

If InStr(1, Cells(i, "A"), "000") + InStr(1, Cells(i, "A"), "123") > 0 Then

Nhưng mà điều kiện này chưa đúng lắm, nó sẽ xóa luôn cái dòng 4 vì có "2000".

Dòng lệnh này không thể gọi là "chưa đúng lắm". Nó có những hai vấn đề:
1. lô gic này diễn theo VBA là "000" HOẶC "123" chứ không phải "000" VÀ "123"
2. Tuy nhìn thì thu gọn được IF's thành 1 dòng nhưng trên thực tế chạy code, VBA sẽ phải duyệt cả hai hàm, cộng kết quả lại rồi so sánh với 0. Code ở bài #2 thì chạy 1 hàm trước, nếu cần mới chạy hàm thứ hai.

befaint · 19/3/21

PHP:

Sub KhôngXóaDòng()
'Tìm dữ liệu thỏa điều kiện và liệt kê vào cột B'
  Dim eRow As Long, i As Long, ii as long, sText as String
  Dim data as variant
  eRow = Range("A" & Rows.Count).End(xlUp).Row + 1
data =Range("A1:A" & eRow).value2
eRow = ubound(data,1) - 1
  For i = 1 To eRow
     sText = data(i,1)
    If InStr(1, sText, "000") > 0 Then
      If InStr(1, sText, "123") > 0 Then
        ii = ii+1
        data(ii,1) = sText
      End If
    End If
  Next i
Range("B:B").clearContents
If ii > 0 then Range("B1").Resize(ii,1).value = data
Msgbox "Xong phim ba con heo con!"
End Sub

VetMini · 19/3/21

befaint đã viết:
PHP:

Range("B:B").clearContents

Clear Contents sẽ lòi ra một mớ dòng trống với màu mè mẫu mã. Mà thói quen của dân ở đây là không màu mè mẫu mã không chịu được.
Delete Row đúng hơn. (Tuy vẫn chưa giải quyết được trường hợp kẻ hàng, nhưng chắc phải ketiano)

Nhattanktnn · 19/3/21

befaint đã viết:

PHP:

Sub KhôngXóaDòng()
'Tìm dữ liệu thỏa điều kiện và liệt kê vào cột B'
  Dim eRow As Long, i As Long, ii as long, sText as String
  Dim data as variant
  eRow = Range("A" & Rows.Count).End(xlUp).Row + 1
data =Range("A1:A" & eRow).value2
eRow = ubound(data,1) - 1
  For i = 1 To eRow
     sText = data(i,1)
    If InStr(1, sText, "000") > 0 Then
      If InStr(1, sText, "123") > 0 Then
        ii = ii+1
        data(ii,1) = sText
      End If
    End If
  Next i
Range("B:B").clearContents
If ii > 0 then Range("B1").Resize(ii,1).value = data
Msgbox "Xong phim ba con heo con!"
End Sub

Theo em nghĩ vẫn chưa hoàn toàn đúng ý thớt

Hoàng Nhật Phương · 19/3/21

Hehe,OT xin chào cả nhà :hug:

, OT xin phép hóng hớt một đoạn code ạ:

Mã:

Option Explicit
Sub Hóng_hót()
    Dim sheet As Worksheet, r As Range, rUni As Range, res
    Set sheet = ThisWorkbook.Worksheets("Sheet1")
    For Each r In sheet.Range("A1").CurrentRegion
        res = r.Value
        If res Like "*000*" And res Like "*123*" Then
            If Not rUni Is Nothing Then
                Set rUni = Union(rUni, r)
            Else
                Set rUni = r
            End If
        End If
    Next r
    If rUni Is Nothing Then
        MsgBox "Khong tim thay dieu kien de xoa dong.", vbInformation, "Don't delete"
        Exit Sub
    End If
    rUni.Select
    res = MsgBox("Ban co muon xoa cac dong duoc lua chon: " & vbNewLine & _
    rUni.Address & " ?", vbYesNo + vbQuestion, "Delete row")
    If res = vbYes Then rUni.EntireRow.Delete Else Exit Sub
End Sub

Long Lee Trung · 19/3/21

Hoàng Nhật Phương đã viết:

Hehe,OT xin chào cả nhà :hug:

, OT xin phép hóng hớt một đoạn code ạ:

Mã:

Option Explicit
Sub Hóng_hót()
    Dim sheet As Worksheet, r As Range, rUni As Range, res
    Set sheet = ThisWorkbook.Worksheets("Sheet1")
    For Each r In sheet.Range("A1").CurrentRegion
        res = r.Value
        If res Like "*000*" And res Like "*123*" Then
            If Not rUni Is Nothing Then
                Set rUni = Union(rUni, r)
            Else
                Set rUni = r
            End If
        End If
    Next r
    If rUni Is Nothing Then
        MsgBox "Khong tim thay dieu kien de xoa dong.", vbInformation, "Don't delete"
        Exit Sub
    End If
    rUni.Select
    res = MsgBox("Ban co muon xoa cac dong duoc lua chon: " & vbNewLine & _
    rUni.Address & " ?", vbYesNo + vbQuestion, "Delete row")
    If res = vbYes Then rUni.EntireRow.Delete Else Exit Sub
End Sub

dạ đoạn code này rất hợp với em ạ, nhưng em có 1 file mới và ví dụ em thêm vào dòng : "If res Like "*2*" And res Like "*4*" And res Like "*20*" Then" (tức là muốn xóa những dòng nào có số 2,4,20) thì code này lại chỉ tìm được 2 dòng, trong khi file của e có rất nhiều như : 02-04-13-20, 02-03-04-xx-20, 01-02-04-15-50....v..v ?? xin giải đáp giúp em

Long Lee Trung · 19/3/21

Nhattanktnn đã viết:
Theo em nghĩ vẫn chưa hoàn toàn đúng ý thớt

dạ đúng rồi,,đoạn code này hắn tìm tất cả

befaint đã viết:

PHP:

Sub KhôngXóaDòng()
'Tìm dữ liệu thỏa điều kiện và liệt kê vào cột B'
  Dim eRow As Long, i As Long, ii as long, sText as String
  Dim data as variant
  eRow = Range("A" & Rows.Count).End(xlUp).Row + 1
data =Range("A1:A" & eRow).value2
eRow = ubound(data,1) - 1
  For i = 1 To eRow
     sText = data(i,1)
    If InStr(1, sText, "000") > 0 Then
      If InStr(1, sText, "123") > 0 Then
        ii = ii+1
        data(ii,1) = sText
      End If
    End If
  Next i
Range("B:B").clearContents
If ii > 0 then Range("B1").Resize(ii,1).value = data
Msgbox "Xong phim ba con heo con!"
End Sub

trước tiên là em cảm ơn đã rep @@. em có up 1 file bên dưới, nếu là ở dạng số thì đoạn vba này chạy chưa chính xác..ví dụ tìm xóa những dòng có số 1 và số 20 thì hắn sẽ tìm luôn những dòng có 11-20, 21-30..kiểu kiểu thế...có thể fix lại giúp em ko.? thứ nhất là xóa luôn những dòng tìm được đúng điều kiện, hiện ra thông báo đã xóa bao nhiêu dòng (có thể ko cần cũng dc), và nếu em muốn thêm 3-4-5-6 điều kiện nữa thì e sẽ làm ntn? em cảm ơn rất nhiều

Bài đã được tự động gộp: 19/3/21

befaint đã viết:

PHP:

Sub KhôngXóaDòng()
'Tìm dữ liệu thỏa điều kiện và liệt kê vào cột B'
  Dim eRow As Long, i As Long, ii as long, sText as String
  Dim data as variant
  eRow = Range("A" & Rows.Count).End(xlUp).Row + 1
data =Range("A1:A" & eRow).value2
eRow = ubound(data,1) - 1
  For i = 1 To eRow
     sText = data(i,1)
    If InStr(1, sText, "000") > 0 Then
      If InStr(1, sText, "123") > 0 Then
        ii = ii+1
        data(ii,1) = sText
      End If
    End If
  Next i
Range("B:B").clearContents
If ii > 0 then Range("B1").Resize(ii,1).value = data
Msgbox "Xong phim ba con heo con!"
End Sub

trước tiên là em cảm ơn đã rep @@. em có up 1 file bên dưới, nếu là ở dạng số thì đoạn vba này chạy chưa chính xác..ví dụ tìm xóa những dòng có số 1 và số 20 thì hắn sẽ tìm luôn những dòng có 11-20, 21-30..kiểu kiểu thế...có thể fix lại giúp em ko.? thứ nhất là xóa luôn những dòng tìm được đúng điều kiện, hiện ra thông báo đã xóa bao nhiêu dòng (có thể ko cần cũng dc), và nếu em muốn thêm 3-4-5-6 điều kiện nữa thì e sẽ làm ntn? em cảm ơn rất nhiều

Nhattanktnn · 19/3/21

Long Lee Trung đã viết:
dạ đúng rồi,,đoạn code này hắn tìm tất cả

trước tiên là em cảm ơn đã rep @@. em có up 1 file bên dưới, nếu là ở dạng số thì đoạn vba này chạy chưa chính xác..ví dụ tìm xóa những dòng có số 1 và số 20 thì hắn sẽ tìm luôn những dòng có 11-20, 21-30..kiểu kiểu thế...có thể fix lại giúp em ko.? thứ nhất là xóa luôn những dòng tìm được đúng điều kiện, hiện ra thông báo đã xóa bao nhiêu dòng (có thể ko cần cũng dc), và nếu em muốn thêm 3-4-5-6 điều kiện nữa thì e sẽ làm ntn? em cảm ơn rất nhiều

Bài đã được tự động gộp: 19/3/21

trước tiên là em cảm ơn đã rep @@. em có up 1 file bên dưới, nếu là ở dạng số thì đoạn vba này chạy chưa chính xác..ví dụ tìm xóa những dòng có số 1 và số 20 thì hắn sẽ tìm luôn những dòng có 11-20, 21-30..kiểu kiểu thế...có thể fix lại giúp em ko.? thứ nhất là xóa luôn những dòng tìm được đúng điều kiện, hiện ra thông báo đã xóa bao nhiêu dòng (có thể ko cần cũng dc), và nếu em muốn thêm 3-4-5-6 điều kiện nữa thì e sẽ làm ntn? em cảm ơn rất nhiều

Mình phải xác định với nhau một vấn đề rõ ràng như thế này:
1/ Đó là dữ liệu của bạn: đầu bài bạn đưa dữ liệu kiểu khác, bài #11 bạn đưa dữ liệu kiểu khác. Dữ liệu thật của bạn là thế nào?
2/ Vấn đề về cách loại bỏ: Dữ liệu của bạn là một chuỗi, vậy trong chuỗi đó bạn muốn bỏ dữ liệu kiểu "000" nhưng lại không muốn bỏ kiểu "2000" chẳng hạn? thế thì trước và sau "000" là ký tự loại nào? Nếu đi liền là số thì không xóa, còn đi liền là ký tự khác số thì xóa. Có phải ý vậy không?

befaint · 19/3/21

Nhattanktnn đã viết:
Dữ liệu thật

Soi cầu, soi xiên, soi lô ấy.

Nhattanktnn · 19/3/21

befaint đã viết:
Soi cầu, soi xiên, soi lô ấy.

Nhỏ giờ em chưa lô đề gì cả, cũng không tìm hiểu nên không biết nó thế nào luôn

befaint · 19/3/21

Nhattanktnn đã viết:
Nhỏ giờ em chưa lô đề gì cả, cũng không tìm hiểu nên không biết nó thế nào luôn

Vậy bây giờ mình làm cho biết.

Long Lee Trung · 19/3/21

Nhattanktnn đã viết:
ác. Dữ liệu thật của bạn là thế nào?
2/ Vấn đề về cách loại bỏ: Dữ liệu của bạn là một chuỗi, vậy trong chuỗi đó bạn muốn bỏ dữ

Nhattanktnn đã viết:
Mình phải xác định với nhau một vấn đề rõ ràng như thế này:
1/ Đó là dữ liệu của bạn: đầu bài bạn đưa dữ liệu kiểu khác, bài #11 bạn đưa dữ liệu kiểu khác. Dữ liệu thật của bạn là thế nào?
2/ Vấn đề về cách loại bỏ: Dữ liệu của bạn là một chuỗi, vậy trong chuỗi đó bạn muốn bỏ dữ liệu kiểu "000" nhưng lại không muốn bỏ kiểu "2000" chẳng hạn? thế thì trước và sau "000" là ký tự loại nào? Nếu đi liền là số thì không xóa, còn đi liền là ký tự khác số thì xóa. Có phải ý vậy không?

ah dữ liệu number và text thì trích xuất khác nhau ạ? @@ a xử lý giúp e file đính kèm bên dưới với. ví dụ là tìm tất cả các dòng có số "2", "4", "20" là xóa hết. rất cảm ơn vì sự nhiệt tình ạ

VetMini · 19/3/21

Long Lee Trung đã viết:
trước tiên là em cảm ơn đã rep @@.

rep = representative : đại diện

Tôi chả buồn soi mói thớt. Tôi chỉ dẫn ra cái bôi tầy cho các bạn muốn học tiếng ngoại nghiêm chỉnh thôi.

Nhattanktnn đã viết:
Nhỏ giờ em chưa lô đề gì cả, cũng không tìm hiểu nên không biết nó thế nào luôn

befaint đã viết:
Vậy bây giờ mình làm cho biết.

Tôi nhớ mình có từng viết bài giải thích nguồn gốc đề, cách đánh, cách bàn thai, cách làm huyện đề, kể cả trường hợp giụt nợ mà.

Hoàng Nhật Phương · 19/3/21

Long Lee Trung đã viết:
dạ đoạn code này rất hợp với em ạ, nhưng em có 1 file mới và ví dụ em thêm vào dòng : "If res Like "*2*" And res Like "*4*" And res Like "*20*" Then" (tức là muốn xóa những dòng nào có số 2,4,20) thì code này lại chỉ tìm được 2 dòng, trong khi file của e có rất nhiều như : 02-04-13-20, 02-03-04-xx-20, 01-02-04-15-50....v..v ?? xin giải đáp giúp em

Hic, Bạn thử lại xem:

Mã:

Option Explicit
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, 20) ' <---  nhập các điều kiện cần xóa
    Dim a(), str As String, txt As String
    Dim i As Long, k As Long, n As Long
    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) < 100 Then
                    txt = txt & "," & "A" & i
                Else
                    k = k + 1
                    ReDim Preserve a(1 To k)
                    a(k) = txt: txt = ""
                End If
            End If
        Next n
    Next i
    sheet.Range("A1").Resize(r).Offset(, 2).ClearContents
    If k = 0 Then Exit Sub
    For i = 1 To k
        txt = a(i)
        sheet.Range(txt).Offset(, 2).Value = "xoa dong nay phai khong ?"
    Next i
End Sub

HieuCD · 19/3/21

Hoàng Nhật Phương đã viết:

Hic, Bạn thử lại xem:

Mã:

Option Explicit
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, 20) ' <---  nhập các điều kiện cần xóa
    Dim a(), str As String, txt As String
    Dim i As Long, k As Long, n As Long
    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) < 100 Then
                    txt = txt & "," & "A" & i
                Else
                    k = k + 1
                    ReDim Preserve a(1 To k)
                    a(k) = txt: txt = ""
                End If
            End If
        Next n
    Next i
    sheet.Range("A1").Resize(r).Offset(, 2).ClearContents
    If k = 0 Then Exit Sub
    For i = 1 To k
        txt = a(i)
        sheet.Range(txt).Offset(, 2).Value = "xoa dong nay phai khong ?"
    Next i
End Sub

dieu_kien = Array(2, 4, 20)

str = "*" & dieu_kien(n) & "*"
If du_lieu(i, 1) Like str Then

Array(2, 4, 20): 20 không cần

Hoàng Nhật Phương · 19/3/21

HieuCD đã viết:
dieu_kien = Array(2, 4, 20)

str = "*" & dieu_kien(n) & "*"
If du_lieu(i, 1) Like str Then

Array(2, 4, 20): 20 không cần

A! Đúng rồi Bác con cảm ơn các HieuCD đã chỉ dẫn, tìm bao gồm chứ không phải tìm chính xác... con máy móc quá làm theo đề bài .

Giúp em xóa dữ liệu dùng VBA theo điều kiện

Thành viên mới

File đính kèm

Chuyên gia GPE

Thành viên tích cực

Chuyên gia GPE

Ăn cùng góc phố

|||||||||||||

Ăn cùng góc phố

Thành viên gắn bó

Thành viên gắn bó

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

|||||||||||||

Thành viên mới

File đính kèm

Ăn cùng góc phố

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó