Tốc độ ẩn hàng không cần thiết VBA

[Vo Duy Minh]

Chào các bạn,

Tôi có lệnh VBA đẻ ẩn hàng các hàng không có thông số (bằng cách đánh dấu cột D số 1 làm ChkCol).
Vấn đề là nếu chỉ có khoảng vài trăm hàng thì lệnh chạy còn chấp nhận được, nhưng khi lên đến 3000 hàng (trong đó có khoảng 2.500 hàng cần ẩn) thì tốc độ quá chậm (có lẽ cả 30 phút không chừng).
Thời đại 4.0 thế thì khó chấp nhận được vì thà ẩn hàng manually thì còn nhanh hơn.
Rất mong được các bạn giúp được lệnh để đẩy nhanh tốc độ xử lý khả quan hơn.
Xin cám ơn các bạn trước.

Sub HideRows_Day()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.Protect UserInterfaceOnly:=True

BeginRow = 8
EndRow = 3000
ChkCol = 4

For RowCnt = BeginRow To EndRow
If Cells(RowCnt, ChkCol).Value = 1 Then
Cells(RowCnt, ChkCol).EntireRow.Hidden = True
Else
Cells(RowCnt, ChkCol).EntireRow.Hidden = False
End If
Next RowCnt
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Range("b6").Select
ActiveWindow.SmallScroll
End Sub

 

[Phuocam]

Tôi thử dùng code bạn gửi, nhưng không được. Nó báo "Subscript out of range"

Thay đổi tên sheet bạn muốn ẩn tại đây:

For Each sh In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4") 'Change here

 

[Vo Duy Minh]

Thay đổi tên sheet bạn muốn ẩn tại đây:

For Each sh In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4") 'Change here

Tôi đã thay đổi tên sheet rồi (giữ cả 'Change here)
Trong danh sách object nó ghi Sheet19 (Day 1), thì tôi lấy Sheet19, Sheet20 thì "Subscript out of range"
Còn "Sheet19 (Day 1)","Sheet20 (Day 2)", ... thì "Object required

Không rõ tôi sai chỗ nào, xin bạn giúp giùm

 

[Cá ngừ F1]

Cám ơn bạn đã hỏi thăm. Sức khoẻ thì bình thường nhưng hơi "mệt" vì cô Vi. Ở Hà Nội mọi người cũng cố gắng nhé. Đợt này hơi nguy hiểm.

Bác siw đang ở HN ạ? Em có thể mời bác cốc cf moka ở Bùi Thị Xuân không ạ?

 

[Phuocam]

Tôi đã thay đổi tên sheet rồi (giữ cả 'Change here)
Trong danh sách object nó ghi Sheet19 (Day 1), thì tôi lấy Sheet19, Sheet20 thì "Subscript out of range"
Còn "Sheet19 (Day 1)","Sheet20 (Day 2)", ... thì "Object required

Thử sửa thành:

For Each sh In Array("Day 1", "Day 2")

 

[batman1]

Bác siw đang ở HN ạ? Em có thể mời bác cốc cf moka ở Bùi Thị Xuân không ạ?

Không, tôi đang ở Ba Lan. Tôi về Hà Nội cả tháng 5 năm 2019. Hồi đó cũng lướt qua Bùi Thị Xuân vì cũng gần nhà để tìm quán "hồi xưa" năm 2006 từng ăn nem cua bể (đi từ Tuệ Tĩnh về hướng Tô Hiến Thành thì ở bên tay trái. Đối diện ở bên kia gần chỗ hồi xưa có cái ngõ đi ra đúng chùa ở Bà Triệu) nhưng quán không còn ở đó. Bây giờ muốn về cũng không được vì đang dịch mà.

 

[Cá ngừ F1]

Không, tôi đang ở Ba Lan. Tôi về Hà Nội cả tháng 5 năm 2019. Hồi đó cũng lướt qua Bùi Thị Xuân vì cũng gần nhà để tìm quán "hồi xưa" năm 2006 từng ăn nem cua bể (đi từ Tuệ Tĩnh về hướng Tô Hiến Thành thì ở bên tay trái. Đối diện ở bên kia gần chỗ hồi xưa có cái ngõ đi ra đúng chùa ở Bà Triệu) nhưng quán không còn ở đó. Bây giờ muốn về cũng không được vì đang dịch mà.

Hình như vẫn còn đó ạ, gần với quán Mỳ vằn thắn thì phải.
xin lỗi chủ thớt, tôi hơi spam 1 chút.

 

[VetMini]

Tiếng Việt:
- đặt tham số là sheet: Sub HideRows_Day_A (meSheet As WorkSheet) -> đổi tên sub thành HideRows_Day_A
- sau dòng Sub, thêm dòng này: With meSheet
- với tất cả những chỗ có Range và Cells, thêm một dấu chấm trước chúng (tức là Range thành .Range)
- trước dòng end sub, thêm dòng này: End With
- xoá hết code trong sub HideRows_Day
- đặt code gọi cho các sheets
Dim sh
For Each sh in Array(WorkSheets("sheet1"), WorkSheets("sheet2"), WorkSheets("sheet3"), WorkSheets("sheet4"), WorkSheets("sheet5"))
HideRows_Day_A sh
Next sh

Bloody English (in case the original poster can read English better than his/her own mother tounge):
- change the sub name and set a parameter: Sub HideRows_Day_A (meSheet As WorkSheet)
- after the line Sub, add this line: With meSheet
- for all occurrences of the word 'Range' or 'Cells', place a period in front (that is, changing Range to .Range)
- before the line End Sub, add this line: End With
- delete all codes inside sub HideRows_Day
- add the following code to operate on the sheets
Dim sh
For Each sh in Array(WorkSheets("sheet1"), WorkSheets("sheet2"), WorkSheets("sheet3"), WorkSheets("sheet4"), WorkSheets("sheet5"))
HideRows_Day_A sh
Next sh

 

[levanduyet]

"công tác tốt" ở trời tây người ta hiếm xài trong giao tiếp lắm!

Tuy nhiên, khi gặp nhau người ta buông câu: "Công việc thế nào?", nhưng chủ iếu gần như là hỏi về sức khỏe.

Như em mà gặp Bác thì chỉ có hỏi "Gặp nhau chổ cũ há Bác".

LVD

 

[SA_DQ]

(/ời Duyệt thì nên cụ thể hơn: Gặp nhau ờ 'Hai Mơ' nha!

 

[Vo Duy Minh]

Tiếng Việt:
- đặt tham số là sheet: Sub HideRows_Day_A (meSheet As WorkSheet) -> đổi tên sub thành HideRows_Day_A
- sau dòng Sub, thêm dòng này: With meSheet
- với tất cả những chỗ có Range và Cells, thêm một dấu chấm trước chúng (tức là Range thành .Range)
- trước dòng end sub, thêm dòng này: End With
- xoá hết code trong sub HideRows_Day
- đặt code gọi cho các sheets
Dim sh
For Each sh in Array(WorkSheets("sheet1"), WorkSheets("sheet2"), WorkSheets("sheet3"), WorkSheets("sheet4"), WorkSheets("sheet5"))
HideRows_Day_A sh
Next sh

Bloody English (in case the original poster can read English better than his/her own mother tounge):
- change the sub name and set a parameter: Sub HideRows_Day_A (meSheet As WorkSheet)
- after the line Sub, add this line: With meSheet
- for all occurrences of the word 'Range' or 'Cells', place a period in front (that is, changing Range to .Range)
- before the line End Sub, add this line: End With
- delete all codes inside sub HideRows_Day
- add the following code to operate on the sheets
Dim sh
For Each sh in Array(WorkSheets("sheet1"), WorkSheets("sheet2"), WorkSheets("sheet3"), WorkSheets("sheet4"), WorkSheets("sheet5"))
HideRows_Day_A sh
Next sh

Cám ơn bạn đã hướng dẫn
Tôi sẽ thực hiện xem sao. Hy vọng it works well.

 

[Vo Duy Minh]

Thử sửa thành:

For Each sh In Array("Day 1", "Day 2")

Cám ơn bạn phuocam.
Nó vẫn "Object required" dù tôi làm cả "Day_1","Day_2"
Dù sao cũng không cẩn thiết lắm, tôi vẫn có thể chạy với từng sheet được
Hơi chút thủ công nhưng đỡ nhọc nhằn cho các bạn
Một lần nữa, tôi rất cám ơn bạn đã nhiệt tình giúp đỡ tôi.

 

[Phuocam]

Cám ơn bạn phuocam.
Nó vẫn "Object required" dù tôi làm cả "Day_1","Day_2"
Dù sao cũng không cẩn thiết lắm, tôi vẫn có thể chạy với từng sheet được
Hơi chút thủ công nhưng đỡ nhọc nhằn cho các bạn
Một lần nữa, tôi rất cám ơn bạn đã nhiệt tình giúp đỡ tôi.

Gửi file lên, xóa các dữ liệu nhạy cảm, chỉ cần giữ tên sheet, việc sửa lỗi dễ dàng hơn.

 

[VetMini]

Cám ơn bạn đã hướng dẫn
Tôi sẽ thực hiện xem sao. Hy vọng it works well.

Có lẽ bạn là người tập toẹ song ngữ.
Tôi chả phải hy vọng gì cả. Tôi chỉ đưa ra giải pháp thông dụng để chuyển một thủ tục (sub) từ dạng chữa cháy 1 sang chữa cháy 2 thôi.

I take it that you are the 'aspriring' bilingual type.
I don't need to put faith in anything. What I presented there is a common solution to convert a procedure (sub) from ad hoc 1 to ad hoc 2.

 

[batman1]

Cám ơn bạn phuocam.
Nó vẫn "Object required" dù tôi làm cả "Day_1","Day_2"
Dù sao cũng không cẩn thiết lắm, tôi vẫn có thể chạy với từng sheet được
Hơi chút thủ công nhưng đỡ nhọc nhằn cho các bạn
Một lần nữa, tôi rất cám ơn bạn đã nhiệt tình giúp đỡ tôi.

Trong bài của mình bạn phuocam không khai báo biến sh. Bạn không đính kèm toàn bộ code nên không ai biết bạn khai báo các biến thế nào. Nên biết rằng trong bài của quick87 và NHN_Phương thì sh được khai báo là Worksheet. Bạn không thể khai báo cho code của phuocam sh cũng là WorkSheet. Phải là Variant - Dim sh As Variant.

Trong code sau đây tôi giữ nguyên code của bạn phuocam, chỉ thêm khai báo sh và rng và các biến khác (bạn mới tập viết code thì nên tạo thói quen tốt là khai báo tường minh tất cả các biến. Tôi thấy trong bài #1 không có khai báo biến. Đừng học thói quen xấu của người khác). Và thêm dòng .Rows.EntireRow.Hidden = False. Tại sao? Giả sử dòng cuối cùng có dữ liệu ở cột A là 20, tức EndRow = 20. Nếu trong tất cả các dòng từ dòng BeginRow = 6 trở xuống ở cột D (do ChkCol = 4) mọi giá trị đều = 1 thì sau khi chạy code bạn sẽ có tất cả các dòng 6-20 bị ẩn. Khi chạy code lần thứ 2 thì do 6-20 bị ẩn nên EndRow < 6 (nếu A1:A5 trống thì EndRow = 1), tức EndRow - BeginRow + 1 <= 0. Lúc này sẽ có lỗi tại dòng .Range("A" & BeginRow).Resize(EndRow - BeginRow + 1).EntireRow.Hidden = True.

Sub HideRows_Day()
Dim sh As Variant
Dim rng As Range
Dim BeginRow As Long, EndRow As Long, ChkCol As Long, rowcnt As Long
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
  
    BeginRow = 6
    ChkCol = 4
  
    For Each sh In Array("Sheet1", "Sheet2") 'Change here
        With Sheets(sh)
            .Rows.EntireRow.Hidden = False
            EndRow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & BeginRow).Resize(EndRow - BeginRow + 1).EntireRow.Hidden = True
            For rowcnt = BeginRow To EndRow
                If .Cells(rowcnt, ChkCol).Value <> 1 Then
                    If rng Is Nothing Then
                        Set rng = .Range("A" & rowcnt)
                    Else
                        Set rng = Union(rng, .Range("A" & rowcnt))
                    End If
                End If
            Next rowcnt
            If Not rng Is Nothing Then rng.EntireRow.Hidden = False
            Set rng = Nothing
        End With
    Next sh
  
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
End Sub

--------------
Nên cho sub HideRows_Day là sub tổng quát. Và không có chuyện mỗi lần lại chỉnh sửa BeginRow, ChkCol và các sheet trong sub tổng quát. Viết sub tổng quát và truyền BeginRow, ChkCol, điều kiện và các sheet ở dạng tham số. Chỉ khi gọi HideRows_Day thì mới truyền các tham số khác nhau trong mỗi lần gọi.

Sub HideRows_Day(ByVal BeginRow As Long, ByVal ChkCol As Long, ByVal dieukien, ByVal sheetsname As String)
'    BeginRow: chi so dong bat dau
'    ChkCol: chi so cot tren sheet ma o day kiem tra dieu kien "dieukien"
'    dieukien: cac dong co o cot ChkCol gia tri <> dieukien thi se bi an.
'    sheetsname: la chuoi chua ten cac sheet can xet ngan caěch nhau boi dau phay ","
Dim sh As Variant
Dim rng As Range
Dim EndRow As Long, rowcnt As Long
'    Application.Calculation = xlCalculationManual
'    Application.ScreenUpdating = False
'    Application.DisplayStatusBar = False
'    Application.EnableEvents = False
  
    For Each sh In Split(sheetsname, ",")
        With Sheets(sh)
            .Rows.EntireRow.Hidden = False
            EndRow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A" & BeginRow).Resize(EndRow - BeginRow + 1).EntireRow.Hidden = True
            For rowcnt = BeginRow To EndRow
                If .Cells(rowcnt, ChkCol).Value <> dieukien Then
                    If rng Is Nothing Then
                        Set rng = .Range("A" & rowcnt)
                    Else
                        Set rng = Union(rng, .Range("A" & rowcnt))
                    End If
                End If
            Next rowcnt
            If Not rng Is Nothing Then rng.EntireRow.Hidden = False
            Set rng = Nothing
        End With
    Next sh
  
'    Application.Calculation = xlCalculationAutomatic
'    Application.ScreenUpdating = True
'    Application.DisplayStatusBar = True
'    Application.EnableEvents = True
End Sub

Bây giờ bạn không sửa code HideRows_Day nữa. Mà là ...

1. Một ngày đẹp trời bạn muốn thực hiện cho 2 sheet Day_1, Day_2, xét từ dòng 6, kiểm tra trong cột 4 (cột D) điều kiện 1 thì code

Sub dep_troi()
    HideRows_Day 6, 4, 1, "Day_1,Day_2"
End Sub

2. Một ngày mưa tầm tã bạn muốn thực hiện cho 2 sheet Day_1, Day_2, xét từ dòng 6, kiểm tra trong cột 3 (cột C) điều kiện "hichic" thì code

Sub mua_tam_ta()
    HideRows_Day 6, 3, "hichic", "Day_1,Day_2"
End Sub