Xoá dòng có điều kiện bằng vba

Mã:
Option Explicit
Sub xoadongcodieukien()
    Dim dc&, i&
    dc = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
    For i = dc To 2 Step -1
        If (Sheet1.Range("A" & i) = Sheet1.Range("C1").Value) Then
            Sheet1.Rows(i).Delete
        End If
    Next i
End Sub
em có code xoá dòng theo điều kiện như trên nhưng nếu dữ liệu lớn dữ liệu load rất lâu, vậy có cách nào để xoá dòng nhanh hơn trong vba excel không ạ?
 

NhanSu

SMod
Thành viên BQT
Mỗi lần xóa dòng thì Excel sẽ phải đẩy dòng ở dưới lên lấp chỗ trống, nếu dòng cần xóa nằm rải rác hoặc xóa từng dòng sẽ rất lâu. Để khắc phục, bạn sử dụng cột phụ để đánh dấu dòng cần xóa rồi sort cho dòng đó xuống dưới, chỉ xóa một lần là xong.
Mã:
Option Explicit
Sub xoadongcodieukien()
Dim dc&, i&, arr1(), arr2(), x, LastCol&
dc = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
Redim arr1(1 to dc - 1, 1 to 1)
Redim arr2(1 to dc - 1, 1 to 1)
arr1 = sheet1.range("A2:A" & dc).value
x = Sheet1.Range("C1").Value
For i = 1 To dc - 1
If arr1(i,1) =  x Then arr(i,2)=1
Next i
LastCol=sheet1.range("A1").end(xltoright).column
Sheet1.Range("A1").offset(1,LastCol).resize(dc-1)=arr2
'Sort bảng dữ liệu và xóa ở đây
End Sub
Do mình viết trên điện thoại nên bạn tự hoàn thiện code nhé.
 
Bạn tham khảo topic này:
Ở trên, bạn NhanSu đã dùng mảng để xử lý nhằm tăng tốc độ, thay vì xử lý trực tiếp trên Excel (cách ban đầu của bạn).
 
Mỗi lần xóa dòng thì Excel sẽ phải đẩy dòng ở dưới lên lấp chỗ trống, nếu dòng cần xóa nằm rải rác hoặc xóa từng dòng sẽ rất lâu. Để khắc phục, bạn sử dụng cột phụ để đánh dấu dòng cần xóa rồi sort cho dòng đó xuống dưới, chỉ xóa một lần là xong.
Mã:
Option Explicit
Sub xoadongcodieukien()
Dim dc&, i&, arr1(), arr2(), x, LastCol&
dc = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
Redim arr1(1 to dc - 1, 1 to 1)
Redim arr2(1 to dc - 1, 1 to 1)
arr1 = sheet1.range("A2:A" & dc).value
x = Sheet1.Range("C1").Value
For i = 1 To dc - 1
If arr1(i,1) =  x Then arr(i,2)=1
Next i
LastCol=sheet1.range("A1").end(xltoright).column
Sheet1.Range("A1").offset(1,LastCol).resize(dc-1)=arr2
'Sort bảng dữ liệu và xóa ở đây
End Sub
Do mình viết trên điện thoại nên bạn tự hoàn thiện code nhé.
cảm ơn @NhanSu rất nhiều mình áp dụng thử
 

phuonghong1997

Yêu THVBA như điếu đổ
Mã:
Option Explicit
Sub xoadongcodieukien()
Dim dc&, i&, arr1(), arr2(), x, LastCol&
dc = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
Redim arr1(1 to dc - 1, 1 to 1)
Redim arr2(1 to dc - 1, 1 to 1)
arr1 = sheet1.range("A2:A" & dc).value
x = Sheet1.Range("C1").Value
For i = 1 To dc - 1
If arr1(i,1) =  x Then arr(i,2)=1
Next i
LastCol=sheet1.range("A1").end(xltoright).column
Sheet1.Range("A1").offset(1,LastCol).resize(dc-1)=arr2
'Sort bảng dữ liệu và xóa ở đây
End Sub
Đề bài : Tìm trên cột A nếu giá trị nào bằng ô C1 thì delete dòng đó đi.
Bạn cần đăng nhập để thấy hình ảnh

Em nghĩ dòng code số 10 của anh sai:
Mã:
If arr1(i,1) =  x Then arr(i,2)=1
Em nghĩ code đúng sẽ là:
Mã:
If arr1(i, 1) = x Then arr2(i, 1) = 1
Khi đó kết quả chạy code sẽ là:
Bạn cần đăng nhập để thấy hình ảnh

Không biết như thế có đúng không.
Em không hiểu chỗ này:
Mã:
'Sort bảng dữ liệu và xóa ở đây
Có phải ý tưởng chỗ này là dùng filter rồi xóa một loạt không ạ?
Bạn cần đăng nhập để thấy hình ảnh

Hay là sort như thế này anh nhỉ:
Bạn cần đăng nhập để thấy hình ảnh

Bạn cần đăng nhập để thấy hình ảnh


Mong được anh chỉ bảo thêm ạ. Em mới học VBA 1 tuần nên nhiều cái còn chưa biết.
 
T

thanhphong

Guest
Em là thanhphong đến từ diễn đàn THVBA.
Em xin phép được sử dụng lại code của bác Smod @NhanSu .
Ở code này em cố gắng giảm thiểu khai báo mảng, không dùng sort. Em sẽ xóa trực tiếp một lần.
Mã:
Sub xoadongcodieukien()
Dim dc&, i&, arr1(), x, LastCol&
Dim rng As Range
Dim cnt As Long

dc = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
ReDim arr1(1 To dc - 1, 1 To 1)
ReDim arr2(1 To dc - 1, 1 To 1)
arr1 = Sheet1.Range("A2:A" & dc).Value
x = Sheet1.Range("C1").Value
cnt = 0
With ThisWorkbook.Sheets(1)
    For i = 1 To dc - 1
        If arr1(i, 1) = x Then
            cnt = cnt + 1
            If cnt = 1 Then
                Set rng = .Rows(i + 1)
            Else
                Set rng = Union(rng, .Rows(i + 1))
            End If
        End If
    Next i
    If cnt > 0 Then
        rng.Delete
    End If
End With

End Sub
Các dòng code tô sáng là nơi em sửa code.
 
Thấy bạn trên dùng phương thức Union. Mình xin gửi 1 cách khác cho mọi người tham khảo:
Mã:
Sub ABC()
    Dim Rng As Range, i&, iRow&, DK$, Arr()
    Application.ScreenUpdating = False
    With Sheet1
        Arr = .Range("A2:A" & .Range("A" & Rows.Count).End(3).Row).Value
        DK = .Range("C1").Value
        For i = 1 To UBound(Arr, 1)
            If Arr(i, 1) = DK Then
                If Rng Is Nothing Then
                    Set Rng = .Range("A" & i + 1)
                Else
                    Set Rng = Union(Rng, .Range("A" & i + 1))
                End If
            End If
        Next i
    If Not Rng Is Nothing Then Rng.EntireRow.Delete
    End With
    Application.ScreenUpdating = True
End Sub
 

NhanSu

SMod
Thành viên BQT
Các bạn thử code xóa vài nghìn dòng không liên tục với dữ liệu khoảng vài trăm nghìn dòng sẽ thấy ý nghĩa của việc sort. Với dữ liệu như vậy, không sort thì thời gian không dưới 15ph, còn vừa sort vừa xóa chỉ 2s. Có điều cần chú ý khi sort thì không nên để công thức vì có thể sau sort thì tham chiếu trong công thức thay đổi nên kết quả sai. Đúng là code của mình viết nhầm và cần bỏ lọc trước khi sort.
 

giaiphapvba

Administrator
Thành viên BQT
Topic từ 2020 mà giờ đào xới lên sôi nổi vậy .
Nếu không hợp cells và định dạng gì, chỉ đơn thuần là dữ liệu, sao không dùng ADO duyệt điều kiện ghi ra mảng .
Clear vùng dữ liệu .
Ghi mảng trả về sheet . Vậy có phải đỡ nhọc không mọi người .
 

AcMilan90

Yêu THVBA
Mọi người cho mình hỏi cách

- Xóa dữ liệu ở một hoặc nhiều ô khi đóng hoặc mở Excel.
- Chỉ cho save mà không cho save as.

Xin cám ơn mọi người.
 
Top