Cải thiện tốc độ cho cấu trúc vòng lặp For (VBA Excel 2013) (1 người xem)

[luongxuan281]

Em có 1 hàm ẩn những hàng trống nhưng dùng For nó tính toán lâu quá.
Các cao nhân nào giúp em chỉnh sửa hàm cho nó tính toán nhanh hơn mà kết quả vẫn như cũ được ạ.
Em cảm ơn mn nhiều
Mn mở file đính kèm là hiểu nha.

 

[phulien1902]

Em có 1 hàm ẩn những hàng trống nhưng dùng For nó tính toán lâu quá.
Các cao nhân nào giúp em chỉnh sửa hàm cho nó tính toán nhanh hơn mà kết quả vẫn như cũ được ạ.
Em cảm ơn mn nhiều
Mn mở file đính kèm là hiểu nha.

Bạn thay dòng:

For i = 9 To 1500

bằng dòng:

For i = 9 To Range("G" & Rows.Count).End(xlUp).Row

 

[luongxuan281]

Bạn thay dòng:

For i = 9 To 1500

bằng dòng:

For i = 9 To Range("G" & Rows.Count).End(xlUp).Row

vẫn vậy bạn ơi đã là hàm For thì khi tính toán nó vẫn ẩn từng dòng à

 

[VetMini]

Tôi thấy bà con hay dùng special cells. Tìm mấy bài đó mà xem code thử.

Nếu gọi theo "cấu trúc" thì vòng lặp for chỉ có thể cải thiện tốc độ bằng cách cho nó nhảy bước. Còn cái vụ ẩn iếc thuôc về format, khác hoàn toàn.

 

[phulien1902]

Tôi thấy bà con hay dùng special cells. Tìm mấy bài đó mà xem code thử.

Nếu gọi theo "cấu trúc" thì vòng lặp for chỉ có thể cải thiện tốc độ bằng cách cho nó nhảy bước. Còn cái vụ ẩn iếc thuôc về format, khác hoàn toàn.

Dùng phương thức SpecialCells để chọn các Cells Empty trong 1 cột rồi ẩn thì tôi thấy nhiều rồi. Nhưng với nhiều cột thì tôi chưa thấy ai dùng.

 

[huuthang_bd]

Em có 1 hàm ẩn những hàng trống nhưng dùng For nó tính toán lâu quá.
Các cao nhân nào giúp em chỉnh sửa hàm cho nó tính toán nhanh hơn mà kết quả vẫn như cũ được ạ.
Em cảm ơn mn nhiều
Mn mở file đính kèm là hiểu nha.

Người ta thương dùng một cột phụ kết hợp với AutoFilter để ẩn hiện những dòng không cần thiết. Đơn giản mà không cần phải dùng Macro.

Còn nếu bạn vẫn muốn dùng Macro thì thử sửa lại như vầy xem:

Sub Marco_An()
Dim Arr, i As Long, j As Long
Application.ScreenUpdating = False
Arr = Range("A4:G1500").Value
For i = 1 To UBound(Arr, 1)
    For j = 1 To UBound(Arr, 2)
        If Len(Arr(i, j)) > 0 Then GoTo Next_i
    Next
    Rows(i + 3).Hidden = True
Next_i:
Next i
Application.ScreenUpdating = True
End Sub

 

[befaint]

Hơi dài dòng nhưng thử xem...

'=========================================
Sub HideRows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim arrTxt(), comTxt As String, chk As Boolean, r As Long, Rng As Range, lR As Long, ws As Worksheet, i As Long
chk = False
Set ws = ActiveSheet
With ws
    lR = LastRow(ws, .Range("C1"))
    If lR <= 5 Then Exit Sub
    arrTxt = .Range("B5:G" & lR).Value2 ''''''''''''''''''''
    For i = 1 To UBound(arrTxt, 1)
        comTxt = arrTxt(i, 1) & arrTxt(i, 2) & arrTxt(i, 3) & arrTxt(i, 5)
        If Len(comTxt) = 0 Then
            r = i + 4 ''''''''''''''''''''''''
            If chk = False Then Set Rng = .Cells(r, 1): GoTo NextCode
            Set Rng = Union(Rng, .Cells(r, 1))
NextCode:
            chk = True
        End If
    Next i
End With
If chk = True Then Rng.EntireRow.Hidden = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

'=========================================
Sub UnhideRows()
    ShowAllRows ActiveSheet
End Sub

'=========================================
Function LastRow(ws As Worksheet, cll As Range) As Long
    ShowAllRows ws
    LastRow = ws.Cells(ws.Rows.Count, cll.Column).End(xlUp).Row
End Function

'=========================================
Sub ShowAllRows(ws As Worksheet)
    ws.AutoFilterMode = False
    ws.Cells.EntireRow.Hidden = False
End Sub

 

[huuthang_bd]

Hơi dài dòng nhưng thử xem...

Dim lR As Long

'=========================================
Sub HideRows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim comTxt As String, chk As Boolean, r As Long, Rng As Range
chk = False
With Sheet1
    LastRow Sheet1, Sheet1.Range("C1")
    Set Rng = .Cells(lR + 1, 1)
    For r = 5 To lR
        comTxt = .Cells(r, 2).Value2 & .Cells(r, 3).Value2 & .Cells(r, 4).Value2 & .Cells(r, 6).Value2
        If Len(comTxt) = 0 Then
            chk = True
            Set Rng = Union(Rng, .Cells(r, 1))
        End If
    Next r
End With
If chk = True Then Rng.EntireRow.Hidden = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

'=========================================
Sub UnhideRows()
    ShowAllRows Sheet1
End Sub

'=========================================
Sub LastRow(ws As Worksheet, cll As Range)
    ShowAllRows Sheet1
    lR = ws.Cells(ws.Rows.Count, cll.Column).End(xlUp).Row
End Sub

'=========================================
Sub ShowAllRows(ws As Worksheet)
    ws.AutoFilterMode = False
    ws.Cells.EntireRow.Hidden = False
End Sub

Bạn lấy tất cả dữ liệu vào một biến mảng rồi kiểm tra các phần tử trên mảng tốc độ sẽ nhanh hơn kiểm tra trực tiếp từng ô trên bảng tính.

 

[luongxuan281]

Hơi dài dòng nhưng thử xem...

Dim lR As Long

'=========================================
Sub HideRows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim comTxt As String, chk As Boolean, r As Long, Rng As Range
chk = False
With Sheet1
    LastRow Sheet1, Sheet1.Range("C1")
    Set Rng = .Cells(lR + 1, 1)
    For r = 5 To lR
        comTxt = .Cells(r, 2).Value2 & .Cells(r, 3).Value2 & .Cells(r, 4).Value2 & .Cells(r, 6).Value2
        If Len(comTxt) = 0 Then
            chk = True
            Set Rng = Union(Rng, .Cells(r, 1))
        End If
    Next r
End With
If chk = True Then Rng.EntireRow.Hidden = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

'=========================================
Sub UnhideRows()
    ShowAllRows Sheet1
End Sub

'=========================================
Sub LastRow(ws As Worksheet, cll As Range)
    ShowAllRows Sheet1
    lR = ws.Cells(ws.Rows.Count, cll.Column).End(xlUp).Row
End Sub

'=========================================
Sub ShowAllRows(ws As Worksheet)
    ws.AutoFilterMode = False
    ws.Cells.EntireRow.Hidden = False
End Sub

Tuy dài nhưng nhanh lắm bạn, bạn có thể làm sao áp dụng được cho nhiều sheet đc k, cái ni chỉ áp dụng cho Sheet1 thôi à