Xóa nhanh từ hàng thứ 3 của một Table tới hàng cuối cùng

[phamvandunghp84]

Mình muốn hỏi cách để xóa nhanh từ hàng thứ 3 tới hàng cuối cùng của tất cả các tapble trong một sheet ?
mình đang dùng code này nhưng chạy rất chậm.

Sub ShrinkTable_All() ' xóa tu hang cuoi giu hai hai hang tren cung, tat ca cac taple
Dim i As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With ThisWorkbook.Worksheets("Sheet1") 'Update Sheet Name
If .ListObjects.Count > 0 Then
For i = 1 To 5000

With .ListObjects(i)
While .ListRows.Count > 3 'Delete last row until first
.ListRows(.ListRows.Count).Delete
Wend

End With
Next i
End If
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[anhduong9x9]

Có người xem mà không ai trả lời. Tội bạn quá mình chỉ viết đơn giản thế này thôi. Hi vọng nó sẽ nhanh nhất. Bạn lưu ý cái cột "A" tôi bôi đậm bên trong hàm find có thể thay đổi sang cột khác ví dụ B, C, D .... mà bạn muốn trả về hàng cuối cùng có chức dữ liệu thông qua biến i, các câu lệnh khác chắc bạn biết hết rồi:

Sub ShrinkTable_All()
Dim i As Long
Application.ScreenUpdating = False
Application.Calculation = False
i = ThisWorkbook.Worksheets("Sheet1").Columns("A").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
Rows("3:" & i).Select 'Chon hang 3 den hang i. tuc i là hàng cuối cùng có chứa dữ liệu.
Selection.Delete Shift:=xlUp
Application.ScreenUpdating = True
Application.Calculation = True
End Sub

Hy vọng đúng ý bạn. Good luck!

 

[phamvandunghp84]

Có người xem mà không ai trả lời. Tội bạn quá mình chỉ viết đơn giản thế này thôi. Hi vọng nó sẽ nhanh nhất. Bạn lưu ý cái cột "A" tôi bôi đậm bên trong hàm find có thể thay đổi sang cột khác ví dụ B, C, D .... mà bạn muốn trả về hàng cuối cùng có chức dữ liệu thông qua biến i, các câu lệnh khác chắc bạn biết hết rồi:

Sub ShrinkTable_All()
Dim i As Long
Application.ScreenUpdating = False
Application.Calculation = False
i = ThisWorkbook.Worksheets("Sheet1").Columns("A").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
Rows("3:" & i).Select 'Chon hang 3 den hang i. tuc i là hàng cuối cùng có chứa dữ liệu.
Selection.Delete Shift:=xlUp
Application.ScreenUpdating = True
Application.Calculation = True
End Sub

Hy vọng đúng ý bạn. Good luck!

Cảm ơn bạn đã đưa ra giải pháp.
Mình chạy thử code của bạn thì báo lỗi ở câu lệnh này:
Selection.Delete Shift:=xlUp

mình tự học mò VBA nên không hiểu lý do tại sao lỗi.
Trong bài toán mình yêu cầu như sau: trong một sheet có nhiều table, mỗi table có số hàng khác nhau. giờ cần viết code để vòng qua các taple để xóa các hàng chỉ giữ lại 3 hàng trên cùng.

mình gửi file nhờ bạn xem thử giúp mình ! Cảm ơn bạn nhiều !

 

[ndu96081631]

Cảm ơn bạn đã đưa ra giải pháp.
Mình chạy thử code của bạn thì báo lỗi ở câu lệnh này:
Selection.Delete Shift:=xlUp

mình tự học mò VBA nên không hiểu lý do tại sao lỗi.
Trong bài toán mình yêu cầu như sau: trong một sheet có nhiều table, mỗi table có số hàng khác nhau. giờ cần viết code để vòng qua các taple để xóa các hàng chỉ giữ lại 3 hàng trên cùng.

mình gửi file nhờ bạn xem thử giúp mình ! Cảm ơn bạn nhiều !

Thử vầy xem:

Sub Test()
  Dim lstObj    As ListObject
  Dim rng       As Range
  Dim wks       As Worksheet
  Set wks = Sheet1
  For Each lstObj In wks.ListObjects
    Set rng = Intersect(lstObj.Range, lstObj.Range.Offset(4))
    If Not rng Is Nothing Then rng.Clear
    lstObj.Resize lstObj.Range.Resize(4)
  Next
End Sub

Cảm thấy clear dữ liệu từ dòng 4 trở đi rồi resize table thành 4 dòng sẽ nhẹ nhàng hơn so với việc xóa dòng

 

[phamvandunghp84]

Thử vầy xem:

Sub Test()
  Dim lstObj    As ListObject
  Dim rng       As Range
  Dim wks       As Worksheet
  Set wks = Sheet1
  For Each lstObj In wks.ListObjects
    Set rng = Intersect(lstObj.Range, lstObj.Range.Offset(4))
    If Not rng Is Nothing Then rng.Clear
    lstObj.Resize lstObj.Range.Resize(4)
  Next
End Sub

Cảm thấy clear dữ liệu từ dòng 4 trở đi rồi resize table thành 4 dòng sẽ nhẹ nhàng hơn so với việc xóa dòng

Woa.. quá tuyệt vời ! Nó chạy rất nhanh không ngờ luôn ạ ! Cảm ơn Anh rất nhiều !

 

[ndu96081631]

Woa.. quá tuyệt vời ! Nó chạy rất nhanh không ngờ luôn ạ ! Cảm ơn Anh rất nhiều !

Bạn hỏi bài hơn một tuần mà đến giờ mới giải quyết xong, bạn có biết tại sao không? Vì bạn đã chậm trễ trong việc đưa file của mình lên.
Rút kinh nghiệm lần sau nhé