Xóa các hàng trong các table, code chạy rất chậm, Làm sao để chạy nhanh hơn?

Maika8008 · 24/4/22

Hoàng Tuấn 868 đã viết:
Chúc mừng anh nha. .

Cảm ơn bạn! Rất vui vì có bạn @Hoàng Tuấn 868 đồng hành.

VetMini · 24/4/22

Maika8008 đã viết:
Dạ, bác. Nhưng nếu thớt bố trí các table đúng trật tự thì khỏi cần băn khoăn. Chờ thớt xác nhận thôi.
...

Hồi nào giờ thớt chạy code trên chỉ chậm thôi chứ không bị cờ-rát (crash).
Chứng tỏ là việc đôn Tables sau khi xoá dòng không hề bị vấn đề.
Tôi đoán là:
1. các tables ở cùng hàng dọc thì sẽ có cột đầu tiên ngay nhau.
2. cột đầu tiên của hàng dọc j+1 sẽ có độ cách tối thiểu với cột cuối cùng của hàng dọc j. Khoảng cách này có lẽ là tối thiểu 1 cột.

Bàn ngoài: Tables 9000 dòng mà đặt chung sheet với 350 tables khác thì đây là thiết kế hàng khủng. Chắc cái table ấy phải Filter bớt chứ để nguyên ai đọc nổi. Mà muốn quản lý hàng này chắc phải có màn hình khá to, hiển thị tile 3-4 windows (của Excel) mới dò nổi.

ptm0412 · 24/4/22

VetMini đã viết:
Bạn có thể sort các Tables theo Address của chúng. Xoá từ dưới lên trên, từ phải qua trái.

Dữ liệu để sort: dòng cuối & cột cuối & tên Table (hoặc chỉ số của nó trong collection)

Theo tôi chỉ cần xóa từ dưới lên trên bất kể vị trí hàng ngang (nghĩa là không cần từ phải qua trái hay từ trái qua phải). Vì:
- Ta đang xóa dòng và Shift Xlup chứ không phải Shift xltoRight, hay là xóa cột Shift xlToLeft
- Code bài 1 chạy tán loạn vị trí, chỉ chậm chứ không lỗi (theo chỉ số i mà ai biết thứ tự tạo 350 cái đã thực hiện thế nào).

htin1997 · 25/4/22

Con hay thấy trường hợp các chú bác bàn tán sôi nỗi về một chủ đề liên quan đến các câu hỏi đặt ngược lại cho chủ thớt thì thường là họ lại đi "lặn", "lặn" rất "sâu"

phamvandunghp84 · 25/4/22

ptm0412 đã viết:
Theo tôi chỉ cần xóa từ dưới lên trên bất kể vị trí hàng ngang (nghĩa là không cần từ phải qua trái hay từ trái qua phải). Vì:
- Ta đang xóa dòng và Shift Xlup chứ không phải Shift xltoRight, hay là xóa cột Shift xlToLeft
- Code bài 1 chạy tán loạn vị trí, chỉ chậm chứ không lỗi (theo chỉ số i mà ai biết thứ tự tạo 350 cái đã thực hiện thế nào).

Bạn ơi vậy cần phải sửa lại code đó như nào để có thể chạy được nhanh hơn?

Bài đã được tự động gộp: 25/4/22

Maika8008 đã viết:
Tôi thực là đã có code cho thớt rồi nhưng nếu không nói rõ thì code sẽ tầm bậy. Lý do: thớt có đến 350 table trên 1 sheet lận, một con số không tưởng đối với tôi.

Các table ở cùng sheet cách nhau bởi 3 cột, hàng tiêu đề và hàng 2 hàng 3 là cùng hàng 1,2,3 của excel bạn ạ.

ongke0711 · 25/4/22

phamvandunghp84 đã viết:
Các table ở cùng sheet cách nhau bởi 3 cột, hàng tiêu đề và hàng 2 hàng 3 là cùng hàng 1,2,3 của excel bạn ạ.

Cho hỏi chút là bạn dùng chữ "Table" là đúng nghĩa thiết kế bảng dữ liệu theo định dạng Table của Excel phải không? Tôi thấy đối với đối tượng "Table" thì nó có các phương thức xóa dòng của nó đó. Bạn tìm hiểu xem.

phamvandunghp84 · 25/4/22

VetMini đã viết:
Xoá dòng của table không ảnh hưởng đến dòng của bảng tính.
Chỉ là thớt xoá từng dòng cho nên bị chậm. Mỗi dòng xoá là Excel lại phải chỉnh các thông số của Table. Nếu xoá cả cụm một lúc thì nhanh hơn.

Đại khái như vầy:
[Table1].Rows("3:" & [Table1].Rows.Count).Delete Shift:=xlUp

bạn ơi vậy mình phải viết lại như nào mới đúng? mình viết như này nhưng không được mong bạn sửa giúp:

Sub ShrinkTable_All_chay_nhanh_hon() ' xóa tu hang cuoi giu hai hai hang tren cung, tat ca cac taple
Dim i As Integer
With ThisWorkbook.Worksheets("Data") 'Update Sheet Name
For i = 1 To 350
[Table & i].Rows("3:" & [Table & i].Rows.Count).Delete Shift:=xlUp
Next i
End With
End Sub

Maika8008 · 25/4/22

phamvandunghp84 đã viết:
Bạn ơi vậy cần phải sửa lại code đó như nào để có thể chạy được nhanh hơn?

Các table ở cùng sheet cách nhau bởi 3 cột, hàng tiêu đề và hàng 2 hàng 3 là cùng hàng 1,2,3 của excel bạn ạ.

Dùng code này thớt nhé, chạy xong cho biết kết quả nhanh chậm thế nào.

Rich (BB code):

Option Explicit

'Hàm lay so thu tu cot dua vao tên cot
Function ColumnName2Number(ByVal strAdr As String)
    Dim lgCol&, i&, j&, k&, arr
    arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
                "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    For i = Len(strAdr) To 1 Step -1
        If Not IsNumeric(Mid(strAdr, i, 1)) Then
            For j = LBound(arr) To UBound(arr)
                If arr(j) = UCase(Mid(strAdr, i, 1)) Then
                    lgCol = lgCol + 26 ^ k * (j + 1)
                    k = k + 1: Exit For
                End If
            Next
        End If
    Next
    ColumnName2Number = lgCol
End Function

'Xoa cac dong cua table, chi chua lai 2 dong data dau tien.
Sub ShrinkTable_All()
Dim i As Integer, rw&, oTbl As Object, tblAdrs$, frw&, fcol&, lcol&, lVT&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("Data")
    If .ListObjects.Count > 0 Then
        For i = .ListObjects.Count To 1 Step -1
            Set oTbl = .ListObjects(i)
            rw = oTbl.ListRows.Count
            If rw > 2 Then
                tblAdrs = .ListObjects(i).HeaderRowRange.Address(0, 0)
                lVT = InStr(1, tblAdrs, ":")
                fcol = ColumnName2Number(Left(tblAdrs, lVT - 1))
                lcol = ColumnName2Number(Right(tblAdrs, Len(tblAdrs) - lVT))
                tblAdrs = .ListObjects(i).HeaderRowRange.Address(1, 0)
                frw = Right(tblAdrs, Len(tblAdrs) - InStrRev(tblAdrs, "$"))
                .Range(.Cells(frw + 3, fcol), .Cells(rw + frw, lcol)).Delete xlUp
            End If
        Next i
    End If
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

VetMini · 25/4/22

phamvandunghp84 đã viết:
bạn ơi vậy mình phải viết lại như nào mới đúng? mình viết như này nhưng không được mong bạn sửa giúp:
... [Table & i].Rows("3:" & [Table & i].Rows.Count).Delete Shift:=xlUp

Bạn cần tìm hiểu về ý nghĩa của dấu ngoặc vuông [ ]
Hình như bạn cũng không biết thế nào là phép cộng chuỗi, dấu &

phamvandunghp84 · 25/4/22

Maika8008 đã viết:

Dùng code này thớt nhé, chạy xong cho biết kết quả nhanh chậm thế nào.

Rich (BB code):

Option Explicit

'Hàm lay so thu tu cot dua vao tên cot
Function ColumnName2Number(ByVal strAdr As String)
    Dim lgCol&, i&, j&, k&, arr
    arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
                "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
    For i = Len(strAdr) To 1 Step -1
        If Not IsNumeric(Mid(strAdr, i, 1)) Then
            For j = LBound(arr) To UBound(arr)
                If arr(j) = UCase(Mid(strAdr, i, 1)) Then
                    lgCol = lgCol + 26 ^ k * (j + 1)
                    k = k + 1: Exit For
                End If
            Next
        End If
    Next
    ColumnName2Number = lgCol
End Function

'Xoa cac dong cua table, chi chua lai 2 dong data dau tien.
Sub ShrinkTable_All()
Dim i As Integer, rw&, oTbl As Object, tblAdrs$, frw&, fcol&, lcol&, lVT&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("Data")
    If .ListObjects.Count > 0 Then
        For i = .ListObjects.Count To 1 Step -1
            Set oTbl = .ListObjects(i)
            rw = oTbl.ListRows.Count
            If rw > 2 Then
                tblAdrs = .ListObjects(i).HeaderRowRange.Address(0, 0)
                lVT = InStr(1, tblAdrs, ":")
                fcol = ColumnName2Number(Left(tblAdrs, lVT - 1))
                lcol = ColumnName2Number(Right(tblAdrs, Len(tblAdrs) - lVT))
                tblAdrs = .ListObjects(i).HeaderRowRange.Address(1, 0)
                frw = Right(tblAdrs, Len(tblAdrs) - InStrRev(tblAdrs, "$"))
                .Range(.Cells(frw + 3, fcol), .Cells(rw + frw, lcol)).Delete xlUp
            End If
        Next i
    End If
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

oh nó đã chạy rất nhanh bạn ạ! Cảm ơn bạn rất nhiều!

VetMini · 25/4/22

Maika8008 đã viết:
Dùng code này thớt nhé, chạy xong cho biết kết quả nhanh chậm thế nào.

Rich (BB code):

Option Explicit 'Hàm lay so thu tu cot dua vao tên cot Function ColumnName2Number(ByVal strAdr As String) ... End Function 'Xoa cac dong cua table, chi chua lai 2 dong data dau tien. Sub ShrinkTable_All() ... End Sub

Code bạn nhiều chỗ thừa lắm.
' dịch tên cột sang số
ColumnName2Number = Range(strAddr).Column
' nếu chỉ có "A", "AB" thì
ColumnName2Number = Cells(1, strAddr).Column

' xoá dòng trong tables
i = 0
For Each lo In Sheets("Data").ListObjects
i = i+1
If i > 350 Then Exit For
lo.AutoFilter.ShowAllData
sheet1.listobjects(1).DataBodyRange.Offset(2, 0).Resize(sheet1.listobjects(1).DataBodyRange.Rows.Count-2).Delete ' giữ lại 2 dòng data, nếu không cần giữ thì không cần offset+resize gì cả
Next lo

Thóc Sama · 25/4/22

Maika8008 đã viết:
tôi được nâng 1 cấp thành viên

Chúc mừng Bác, Cảm giác như được thăng chức Bác hả?
Nói như các Bác lãnh đạo thường nói là: ~bla, bla vinh dự, tự hào và bên cạnh đó là trách nhiệm lớn lao trên cương vị mới ... bla, bla.
Hy vọng các thành viên GPE sẽ nhận được nhiều hơn sự giúp đỡ từ Bác và các Bác "Cội" khác!
$||\$

VetMini · 25/4/22

Maika8008 đã viết:
...
Qua đây tôi gửi lời cảm ơn chân thành đến bác VetMini đã không ngại nhận tôi là bạn dù cách xa tuổi tác và kiến thức, sở học. Cảm ơn bác ptm0412 "lão chết tiệt" luôn làm tôi nể phục về sự công bằng của 1 Super Moderator (tất nhiên không cần nhắc đến học thuật vì ai cũng biết rồi).

Tình cờ là 2 bác đều có mặt trong thớt này.

Hễ tôi mạnh dạn chỉnh code, chỉnh công thức thì tôi coi là bạn.
Chỉ có lão già kia, tôi chỉnh luôn tiếng Tây của lão cho nên tôi không thèm nhận là bạn. ###@#!

Maika8008 · 25/4/22

VetMini đã viết:
Code bạn nhiều chỗ thừa lắm.
' dịch tên cột sang số
ColumnName2Number = Range(strAddr).Column
' nếu chỉ có "A", "AB" thì
ColumnName2Number = Cells(1, strAddr).Column

' xoá dòng trong tables
i = 0
For Each lo In Sheets("Data").ListObjects
i = i+1
If i > 350 Then Exit For
lo.AutoFilter.ShowAllData
sheet1.listobjects(1).DataBodyRange.Offset(2, 0).Resize(sheet1.listobjects(1).DataBodyRange.Rows.Count-2).Delete ' giữ lại 2 dòng data, nếu không cần giữ thì không cần offset+resize gì cả
Next lo

Cảm ơn bác. Chỗ ColumnName2Number thì đúng là tôi nghĩ quẩn nên mất công lấy địa chỉ rồi cắt chuỗi. Còn chỗ sheet1.listobjects(1).DataBodyRange.Offset(2, 0).Resize(sheet1.listobjects(1).DataBodyRange.Rows.Count-2).Delete tôi sẽ ghi nhớ bởi khi làm không biết thuộc tính của table.

VetMini · 25/4/22

Maika8008 đã viết:
... Còn chỗ sheet1.listobjects(1).DataBodyRange.Offset(2, 0).Resize(sheet1.listobjects(1).DataBodyRange.Rows.Count-2).Delete tôi sẽ ghi nhớ bởi khi làm không biết thuộc tính của table.

Khi bạn tạo Table thì Excel cũng tạo một đống Object Table1, Table2, ...
Nếu bạn không nhớ thuộc tính DataBodyRange của ListObject thì có thể dùng Named Object như ví dụ ở bài #7
Trong ví dụ này, tôi dùng toán tử [ ] để truy cập Object tên là "Table1"

Chú:
[Table1] trả về một Range là các dòng dữ liệu của Table1, giống như Range("Table1")
Cũng như [A1] trả về 1 range, giống Range("A1")
1. Dùng [ ] thì bắt buộc phải dùng hằng, không thể ["A" & "1"]
2. [ ] gọi hàm Evaluate và ép kiểu kết quả cho nên không hiệu quả bằng Range(str)

phamvandunghp84 · 25/4/22

VetMini đã viết:
Code bạn nhiều chỗ thừa lắm.
' dịch tên cột sang số
ColumnName2Number = Range(strAddr).Column
' nếu chỉ có "A", "AB" thì
ColumnName2Number = Cells(1, strAddr).Column

' xoá dòng trong tables
i = 0
For Each lo In Sheets("Data").ListObjects
i = i+1
If i > 350 Then Exit For
lo.AutoFilter.ShowAllData
sheet1.listobjects(1).DataBodyRange.Offset(2, 0).Resize(sheet1.listobjects(1).DataBodyRange.Rows.Count-2).Delete ' giữ lại 2 dòng data, nếu không cần giữ thì không cần offset+resize gì cả
Next lo

Bác ơi code của bác tôi chạy bị báo lỗi này, Bác xem giúp tôi với:
( hay là do lỗi Sheets("Data") với Sheet1.ListObjects(1)?, Thấy hai dòng lệnh này có tên sheet khác nhau hả bác?)

Bài đã được tự động gộp: 25/4/22

phamvandunghp84 đã viết:
Bác ơi code của bác tôi chạy bị báo lỗi này, Bác xem giúp tôi với:
( hay là do lỗi Sheets("Data") với Sheet1.ListObjects(1)?, Thấy hai dòng lệnh này có tên sheet khác nhau hả bác?)

Mình thử như này vẫn lỗi, Bác xem sửa lại code giúp mình:

Sub xoa_chi_giu_lai_hai_hang_dau()
i = 0
For Each lo In Sheets("Data").ListObjects
i = i + 1
If i > 350 Then Exit For
lo.AutoFilter.ShowAllData
Sheets("Data").ListObjects(1).DataBodyRange.Offset(2, 0).Resize(Sheets("Data").ListObjects(1).DataBodyRange.Rows.Count - 2).Delete ' gi? l?i 2 dòng data, n?u không c?n gi? thì không c?n offset+resize gì c?
Next lo
End Sub

VetMini · 25/4/22

Sửa:
sheet1.listobjects(1).DataBodyRange.Offset(2, 0).Resize(sheet1.listobjects(1).DataBodyRange.Rows.Count2).Delete
Thành
lo.DataBodyRange.Offset(2, 0).Resize(lo.DataBodyRange.Rows.Count-2).Delete

Xin lỗi. Code test tôi chép đại vào, lười xem kỹ lại.

Maika8008 · 25/4/22

phamvandunghp84 đã viết:
Bác ơi code của bác tôi chạy bị báo lỗi này, Bác xem giúp tôi với:
( hay là do lỗi Sheets("Data") với Sheet1.ListObjects(1)?, Thấy hai dòng lệnh này có tên sheet khác nhau hả bác?)

View attachment 275004

Bài đã được tự động gộp: 25/4/22

Mình thử như này vẫn lỗi, Bác xem sửa lại code giúp mình:

Sub xoa_chi_giu_lai_hai_hang_dau()
i = 0
For Each lo In Sheets("Data").ListObjects
i = i + 1
If i > 350 Then Exit For
lo.AutoFilter.ShowAllData
Sheets("Data").ListObjects(1).DataBodyRange.Offset(2, 0).Resize(Sheets("Data").ListObjects(1).DataBodyRange.Rows.Count - 2).Delete ' gi? l?i 2 dòng data, n?u không c?n gi? thì không c?n offset+resize gì c?
Next lo
End Sub

View attachment 275005

Bạn phải thay ListObject(1) bằng LítObject(i) và phải có điều kiện số dòng > 2 chứ. Nhưng nhìn code thì nhiều thứ không ổn lắm. Tôi viết lại thế này nè:

Rich (BB code):

Sub DeleteTableRows_2()
Dim LstObj As Object

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each LstObj In Sheets("Data").ListObjects
    If rw > 2 Then LstObj.DataBodyRange.Offset(2, 0).Resize(LstObj.DataBodyRange.Rows.Count - 2).Delete xlUp
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

VetMini · 25/4/22

Maika8008 đã viết:
... Nhưng mà bỏ qua các chuyện bên trên đi. Sau bài này, tôi được nâng 1 cấp thành viên. Đấy là vinh hạnh và cũng là động lực với tôi trong hành trình cùng GPE.
...

Chuyện nâng cấp cũng tức cười lắm.
Toi nhớ cách đây không lâu lắm, tôi được GPE thăng cấp lên sao hay kim cương gì đó quên rồi. Nhìn cục kim cương sến bỏ bố nhưng nhìn qua hạng thành viên, tôi giật mình toát mồ hôi hột: "ăn ngủ cùng GPE".
Đúng là cái cớ để vợ tôi chửi tôi là đồ mê mạng xã hội, bỏ bê gia đình.
Tôi tính phản ánh lên chỗ "góp ý". Chợt nhớ lại lão Đai-môn hay bạn Tuay-đai (twice die region West) có nói là chỉ cần đổi câu si-lô-gân thì xong. Tôi vào đổi nó thành "ăn cùng góc phố".
Bà xã tôi chấp nhận từ "cùng" của tôi có nghĩa là everywhere/wherever chứ không phải là with. Thoát, mừng hú vía.

phamvandunghp84 · 25/4/22

Maika8008 đã viết:
Bạn phải thay ListObject(1) bằng LítObject(i) và phải có điều kiện số dòng > 2 chứ. Nhưng nhìn code thì nhiều thứ không ổn lắm. Tôi viết lại thế này nè:

Rich (BB code):

Sub DeleteTableRows_2() Dim LstObj As Object Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each LstObj In Sheets("Data").ListObjects If rw > 2 Then LstObj.DataBodyRange.Offset(2, 0).Resize(LstObj.DataBodyRange.Rows.Count - 2).Delete xlUp Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

bạn ơi code này sao mình nhấn f5 thấy không chạy bạn ạ?

Xóa các hàng trong các table, code chạy rất chậm, Làm sao để chạy nhanh hơn?

Thành viên gạo cội

Ăn cùng góc phố

Bad Excel Member

Dậm chân tại chỗ là đi lùi.

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên gạo cội

Ăn cùng góc phố

Thành viên thường trực

Ăn cùng góc phố

＿/＿/＿/＿/＿/＿/＿/

Ăn cùng góc phố

Thành viên gạo cội

Ăn cùng góc phố

Thành viên thường trực

Ăn cùng góc phố

Thành viên gạo cội

Ăn cùng góc phố

Thành viên thường trực

Đếm ngược thời gian