Tổng hợp code: Xoá dòng có điều kiện bằng vba

Chia sẻ bởi:hrspring.tides
★★★★★
Quảng cáo
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 ạ?

Cách 1:
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.

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

Hoặc:
Giảm thiểu khai báo mảng, không dùng sort, xóa trực tiếp một lần:

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ách khác cho mọi người tham khảo:

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

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

Khóa học Power PI – Ứng dung trong Nhân sự
Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học
★★★★★ 5 ★ 1 👤 0 ▥ 0
Quảng cáo

Bạn nên đọc

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo

Cũ vẫn chất

Xem thêm