Có Code nào Delete các dòng bằng vùng Range không?

[hung2412]

Xin chào các bạn GPE!
Tôi có một File Excel

Tôi muốn sử dụng Code để Delete các dòng bằng vòng lặp For Next (Làm việc với Range) như sau:

Sub Test()
Dim rng As Range
For Each rng In Selection
    rng.EntireRow.Delete
Next

Nếu làm việc với cell thì rất chậm nếu là nhiều dữ liệu. Liệu có Code nào làm việc với Range để Delete các dòng trên không vì Code trên Delete không hiệu quả (Vì hay bị sót dòng)
Mong các bạn chỉ giáo cho.

 

[snow25]

Xin chào các bạn GPE!
Tôi có một File Excel
View attachment 231423
Tôi muốn sử dụng Code để Delete các dòng bằng vòng lặp For Next (Làm việc với Range) như sau:

Sub Test()
Dim rng As Range
For Each rng In Selection
    rng.EntireRow.Delete
Next

Nếu làm việc với cell thì rất chậm nếu là nhiều dữ liệu. Liệu có Code nào làm việc với Range để Delete các dòng trên không vì Code trên Delete không hiệu quả (Vì hay bị sót dòng)
Mong các bạn chỉ giáo cho.

Bạn nói rõ không hiệu quả chỗ nào.Nếu mà chậm thì dùng mảng cho nhanh nhé.

 

[SA_DQ]

Vấn đề của bạn đang là:
(1) Chậm
(2) Không hiệu quả (do sót)

Ta bàn đến cái không hiệu quả trước; sau đó mới tới chuyện chậm hay nhajnh

(A) Muốn không sót, ta phải tiến hành xóa dòng từ dưới lên (Nếu là dùng vòng lặp)
Cũng có thể xóa từ trên xuống (với những dòng thỏa điều kiện, 1 khi ta khai báo thêm 1 tham biến có kiểu dạng là vùng range
Trong quá trình duyệt cái dòng nào thoả ta cho vô tham biến đó;
Cuối cùng ta xóa những dòng trong tham biến đó 1 lần
Cách nữa như bài trước đã trả lời.
Còn có thể có vài cách nữa, dài dòng & lượm thượm hơn . . . .

(B) Sau cái chuyện đúng rồi, muốn nhanh mới được tính đến.; Nhưng chuyện này nên có file giả lập thì hơn

Chào bạn & chúc vui!

 

[batman1]

Nếu tôi hiểu ý thì là ...

Nếu vùng chọn là vùng hình chữ nhật một khối liền - vùng chọn là 1 Area - thì code chỉ là

Sub Test()
    Selection.EntireRow.Delete
End Sub

Ví dụ chọn B4:B10 (chọn B4:Z10 cũng chả sao) thì sau khi chạy code chỉ còn dòng "Cá", "Mãng cầu".

Nhưng trong trường hợp tổng quát bạn có thể chọn 1 hoặc nhiều vùng / ô ̣nên trong trường hợp tổng quát thì code là.

Sub Test()
Dim k As Long, rng As Range
    Set rng = Selection.Areas(1).EntireRow
    For k = 2 To Selection.Areas.Count
        Set rng = Union(rng, Selection.Areas(k).EntireRow)
    Next k
    rng.Delete
End Sub

 

[HeSanbi]

Dim rng As Range
For Each rng In Selection
    rng.EntireRow.Delete
Next

---------------

Code này Delete không phải sót dòng mà sẽ sai lệch dòng Delete.

Nếu Delete Từng dòng thì dòng delete tiếp theo sẽ trật dòng đã định.

Vì vậy cần Delete Dòng cuối về dòng đầu tiên của Selection. Tuy nhiên cũng sẽ sai lệch dòng nếu hai Vùng có chứa hàng chung.

Và trách trường hợp Delete Cả một Trang tính bằng cách so sánh với địa chỉ của Cells.

---------------

'Cách 1:'
Sub DeleteEntireRow1()
    On error resume next
    Dim R, Rs As Range
    For Each R in Selection.Areas
        If R.EntireRow.Address(0,0) <> Cells.Address(0,0) Then
          If Rs Is nothing then
            Set Rs = R.EntireRow
          Else
            Set Rs = Union(Rs, R.EntireRow)
          End if
        End if
    Next
    Rs.Delete
End Sub
'Cách 2: (Chứa rủi ro)'
'-------------------------'
Sub DeleteEntireRow2()
    On error resume next
    Dim R&
    For R = Selection.Areas.Count To 1 Step -1
      If Selection.Areas(R).EntireRow.Address(0,0) <> Cells.Address(0,0) Then
          Selection.Areas(R).EntireRow.Delete
      End If
    Next
End Sub

-------------------

*Lưu ý: Khi delete cần phải viết Code Undo lại. Để tránh trường hợp Delete nhằm buộc phải đóng và mở lại File.

Private BackupData()

Sub DeleteEntireRow3()
    On Error Resume Next
    Dim R, K&, Rs As Range, Arr As Variant
    ReDim BackupData(1 To Selection.Areas.Count, 1 To 2)
    For Each R In Selection.Areas
        K = K + 1
        Arr = R.EntireRow.Formula
        Set BackupData(K, 1) = R.EntireRow
        BackupData(K, 2) = Arr
        If R.EntireRow.Address(0, 0) <> Cells.Address(0, 0) Then
          If Rs Is Nothing Then
            Set Rs = R.EntireRow
          Else
            Set Rs = Union(Rs, R.EntireRow)
          End If
        End If
    Next
    Application.OnUndo "Undo EntireRow Delete", _
                  "'" & ThisWorkbook.Name & "'!DeleteEntireRow_Undo"
    Rs.Delete
End Sub

Sub DeleteEntireRow_Undo()
  On Error Resume Next
  Dim K&, UB&
  UB = UBound(BackupData)
  If VBA.Err Then Exit Sub
  For K = 1 To UB
    BackupData(K, 1).Formula = BackupData(K, 2)
  Next
  Erase BackupData
  On Error GoTo 0
End Sub

 

[VetMini]

Nếu tôi hiểu ý thì là ...

Theo tôi hiểu thì là thớt chỉ thả một câu lưng lửng rồi chọn lấy ý kiến của một bạn nào đó. Bạn mà "hiểu" được thì "sáng kiến" của thớt hết cơ giữ bản quyền.
Thớt đang thực hiện một đồ án lớn. Lâu lâu thả một lưỡi câu kiếm đồ nhậu thôi.

 

[be_09]

Theo tôi hiểu thì là thớt chỉ thả một câu lưng lửng rồi chọn lấy ý kiến của một bạn nào đó. Bạn mà "hiểu" được thì "sáng kiến" của thớt hết cơ giữ bản quyền.
Thớt đang thực hiện một đồ án lớn. Lâu lâu thả một lưỡi câu kiếm đồ nhậu thôi.

Nhìn câu, cú của chủ Topic tôi liên tưởng đến thành viên Mazda (vì bị mắng một lần).

 

[ppc0312]

Và cũng sớm lật bánh tráng nướng vui xuân vui vài năm
Như đây

Cần công thức để lấy tỷ lệ zoom trong Excel

Xin chào các bạn GPE! Tôi có 1 file Excel, có công thức nào để lấy tỷ lệ zoom trong Excel không? Ví dụ tỷ lệ zoom là 70%, 90%, ... Mong các bạn giúp tôi với.

www.giaiphapexcel.com

 

[SA_DQ]

Mô phật, bần tăng không ăn chay nên không thấy chuyện này!

 

[batman1]

Theo tôi hiểu thì là thớt chỉ thả một câu lưng lửng rồi chọn lấy ý kiến của một bạn nào đó. Bạn mà "hiểu" được thì "sáng kiến" của thớt hết cơ giữ bản quyền.
Thớt đang thực hiện một đồ án lớn. Lâu lâu thả một lưỡi câu kiếm đồ nhậu thôi.

Ơ người quen à? Nửa đêm mà, tôi cũng chả nhìn kỹ nữa.

 

[hung2412]

Sub Test()

Dim rng As Range
For Each rng In Selection
    rng.EntireRow.Delete
Next

Cảm ơn mọi người đã đưa ra ý kiến và giải pháp. Nhưng ý tôi là làm thế nào để Code trên Delete từ dưới lên trên cơ. Ví dụ như là với cell thì như vầy:
Sub Test()

Dim i As Long
For i = Dongcuoi to 1 Step -1
    Cells(i,1).entirerow.Delete
Next

 

[batman1]

Nhưng ý tôi là làm thế nào để Code trên Delete từ dưới lên trên cơ.

Bạn muốn dùng bữa thì người ta nấu cho bạn. Chỉ kết quả là quan trọng, miễn sao cơm dẻo, canh không mặn, cá rán không bị cháy là được. Thứ tự nấu để mà làm gì?
Mà cái này là bây giờ bạn mới nói chứ trước đó có thấy "nhấn mạnh" gì đâu?
Thôi thì bạn tự làm nhé. Tôi luôn chỉ viết theo ý mình, nếu yêu cầu không quá phi lý thì tôi chiều, còn nếu quá phi lý thì tôi không chiều. Mà phi lý hay không là do tôi đánh giá, chứ không phải là người hỏi. Thế thôi.

 

[hung2412]

Bạn muốn dùng bữa thì người ta nấu cho bạn. Chỉ kết quả là quan trọng, miễn sao cơm dẻo, canh không mặn, cá rán không bị cháy là được. Thứ tự nấu để mà làm gì?
Mà cái này là bây giờ bạn mới nói chứ trước đó có thấy "nhấn mạnh" gì đâu?
Thôi thì bạn tự làm nhé. Tôi luôn chỉ viết theo ý mình, nếu yêu cầu không quá phi lý thì tôi chiều, còn nếu quá phi lý thì tôi không chiều. Thế thôi.

Xin lỗi, có lẽ tôi trình bày ở #1 không rõ ràng lắm (Mặc dù tôi cố gắng bày tỏ mong muốn của mình).

 

[SA_DQ]

Sub XoaDongCoDuLieu()
Dim Rng As Range
Dim fRw As Long, lRw As Long

Set Rng = [B4].CurrentRegion
fRw = Rng(1).Row:                          lRw = Rng(1).End(xlDown).Row
Rows(fRw & ":" & lRw).Delete
End Sub

Phương án khác:

Sub XoaCacDongCoDuLieu()
Dim Rng As Range
Dim fRw As Long, lRw As Long

Set Rng = [B1].End(xlDown)
fRw = Rng.Row
lRw = Cells(65500, Rng.Column).End(xlUp).Row
Rows(fRw & ":" & lRw).Delete
End Sub

 

[ppc0312]

Sub XoaDongCoDuLieu()
Dim Rng As Range
Dim fRw As Long, lRw As Long

Set Rng = [B4].CurrentRegion
fRw = Rng(1).Row:                          lRw = Rng(1).End(xlDown).Row
Rows(fRw & ":" & lRw).Delete
End Sub

Phương án khác:

Sub XoaCacDongCoDuLieu()
Dim Rng As Range
Dim fRw As Long, lRw As Long

Set Rng = [B1].End(xlDown)
fRw = Rng.Row
lRw = Cells(65500, Rng.Column).End(xlUp).Row
Rows(fRw & ":" & lRw).Delete
End Sub

Thế xóa kiểu này cho nhanh
Worksheets("Sheet1").Delete

 

[VetMini]

Xoá kiểu này còn nhanh hơn.
Chết cha, xoá luôn cả bộ nhớ rồi, quên mất nó ra sao.

 

[batman1]

Thế xóa kiểu này cho nhanh
Worksheets("Sheet1").Delete

Nhanh hơn chút xíu thôi (Set Rng = , fRw = , lRw =), nhưng cũng chỉ khi chỉ B4 có dữ liệu.
Vấn đề quan trọng là không delete được chỉ một vùng nào đấy. Xóa hết thì quá dễ.

Mà người ta không muốn xóa trong một nốt nhạc. Người ta muốn xóa từng dòng, và phải xóa từ dưới lên, chứ từ trên xuống cũng không đạt yêu cầu.

 

[SA_DQ]

Có khi nào chỉ xóa cá & tôm thôi hay không nhỉ, mô phật, bần tăng tự hỏi!

 

[VetMini]

Có khi nào chỉ xóa cá & tôm thôi hay không nhỉ, mô phật, bần tăng tự hỏi!

Gần hết mùng năm rồi mà đầu óc còn ám ảnh gánh bầu cua hở?

Chú: Xoá cá tôm thì còn lại 4 con. Chế viên xí ngầu dạng khối 4 mặt tam giác cũng còn được.

 

[SA_DQ]

Gần hết mùng năm rồi mà đầu óc còn ám ảnh gánh bầu cua hở? . . . . .

Ông bà mình nói: "Tháng Giêng là tháng ăn chơi mà"
Vã lại về hưu rối thì 13 tháng (nếu có nhuận) cũng là 13 tháng ăn chơi thôi!

(Để khỏi mang tiếng là lạm dụng):

Sub XoaTuDuoiLenTheoDieuKien()
Const CanXoa As String = "Cá Tôm Chôm chôm GPE.COM "
Dim Rng As Range, Cls As Range
Dim J As Long

Set Rng = Range([B1].End(xlDown), [B65500].End(xlUp))
If Rng Is Nothing Then Exit Sub
For J = Rng.Cells.Count To 1 Step -1
    If InStr(CanXoa, Rng(J).Value) Then
        Rows(Rng(J).Row & ":" & Rng(J).Row).Delete
    End If
Next J
End Sub