Option Explicit
Sub An5DongTrong()
Dim SoDg As Long
Dim Cls As Range, aRng As Range
For Each Cls In Range("E2:E33")
If Cls.Value = "" Then
SoDg = SoDg + 1
If SoDg = 1 Then
Set aRng = Cls
ElseIf SoDg < 5 Then
Set aRng = Union(aRng, Cls)
ElseIf SoDg = 5 Then
Union(aRng, Cls).EntireRow.Hidden = True
Set aRng = Nothing: SoDg = 0
End If
Else
Set aRng = Nothing: SoDg = 0
End If
Next Cls
End Sub
Option Explicit
Sub an_dong()
Dim i As Long, dem As Long, vung As Range, vung2 As Range
Set vung = Range("A1")
For i = 2 To 33
If IsEmpty(Cells(i, 5).Value) Then
dem = dem + 1
If dem = 5 Then
Set vung = Union(Cells(i, 5).Offset(-4).Resize(5), vung)
dem = 0
End If
Else
dem = 0
End If
Next i
Set vung2 = Intersect([E2:E100], vung)
vung2.EntireRow.Hidden = True
End Sub
Public Sub GPE()
Dim Cll As Range, Num As Long
For Each Cll In Range("E2:E33")
If Cll.Value = "" Then
Num = Num + 1
Else
Num = 0
End If
If Num = 5 Then
Rows(Cll.Row & ":" & Cll.Offset(-4).Row).EntireRow.Hidden = True
Num = 0
End If
Next
End Sub
Option Explicit
Sub An5OTrongLienTiep()
Dim J As Long: Dim Rng As Range
For J = 2 To 44 Step 5
Set Rng = Cells(J, "E").Resize(5)
If Application.WorksheetFunction.Sum(Rng) = 0 Then
Rng.EntireRow.Hidden = True
End If
Next J
End SubOption Explicit
Sub An5OTrongLienTiep()
Dim J As Long: Dim Rng As Range
For J = 2 To 44 Step 5
Set Rng = Cells(J, "E").Resize(5)
If Application.WorksheetFunction.CountBlank(Rng) = 5 Then
Rng.EntireRow.Hidden = True
End If
Next J
End SubFor J = 2 To 7000 Step 5
Mạng phép sử dụng code của bạn HYen17 và chỉnh sửa chút đỉnh để tăng tốc, hy vọng đáp ứng yêu cầu của bạn.
Sub An5OTrongLienTiep()
Dim J As Long, vung As Range, Rng As Range, kt As Boolean
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
For J = 2 To 8097 Step 5
Set Rng = Cells(J, "E").Resize(5)
If Application.WorksheetFunction.CountBlank(Rng) = 5 Then
If vung Is Nothing Then
Set vung = Rng
Else
Set vung = Union(vung, Rng)
End If
End If
Next J
vung.EntireRow.Hidden = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Option Explicit
Sub AnNhomDongTrong()
Dim Sarr, tam(1 To 60000) As Variant
Dim i, j, k As Long
Dim rng As Range
Sarr = [e2:e8101]
For i = 1 To UBound(Sarr) Step 5
If Trim(Sarr(i, 1)) = "" Then
k = k + 1
tam(k) = "E" & i + 1 & ":E" & i + 5
End If
Next
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = 1 To k
Range(tam(i)).EntireRow.Hidden = True
Next
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End SubOption Explicit
Sub AnNhomDongTrong()
Dim Sarr, tam(1 To 60000) As Variant
Dim i, j, k As Long
Dim rng, VUNG As Range
Sarr = [e2:e8101]
For i = 1 To UBound(Sarr) Step 5
If Trim(Sarr(i, 1)) = "" Then
Set rng = Range("E" & i + 1 & ":E" & i + 5)
If VUNG Is Nothing Then
Set VUNG = rng
Else
Set VUNG = Union(VUNG, rng)
End If
End If
Next
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
VUNG.EntireRow.Hidden = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
