Cách 1: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 ạ?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
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.
PHP:
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:
PHP:
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:
JavaScript:
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
Related threads
Tài liệu User form Excel Cơ bản đến Nâng cao
- Thread starter hrspring.tides
- Ngày bắt đầu
Tự động căn chỉnh chiều cao dòng trong Excel
- Thread starter hrspring.tides
- Ngày bắt đầu
Tinh tổng các ô được tô màu
- Thread starter hrspring.tides
- Ngày bắt đầu