Tự động ẩn hiện dòng

Chia sẻ bởi:hands

★★★★★

‹ Code Ẩn dòng theo điều kiện ngày... Tự động ẩn dòng khi giá trị... ›

Quảng cáo

Có anh chị nào biết cách làm tự động ẩn hàng khi hàng đó không có giá trị và tự động hiện ra khi hàng đó có giá trị không ạ! giúp em với. Em cảm ơn ạ

@THANHNGUYEN24101994@GMAIL
Bạn có thể tham khảo Hàm UDF được viết bằng VBA dưới đây

TỰ ĐỘNG ẨN DÒNG TRỐNG HIỆN DÒNG CÓ CHỨA GIÁ TRỊ
với Hàm S_AutoHide

Hướng dẫn sử dụng hàm:
Hàm có 4 tham số :

Vị trí
Tham số
Kiểu
Chức năng

Target
Vùng đối tượng
Nhập mảng đối tượng cần xét

WrapText
Có/Không
Tự động Wraptext

Show
Có/Không
Hiện lại

Title
Chuỗi
Tiêu đề đặt cho giá trị trả về của ô nhập (Không cần thiết)

Ví dụ cách viết hàm:

=S_AutoHide(A1:F10000,TRUE, False, "Tự động Ẩn/Hiện")

Sao chép mã bên dưới vào một Module mới, và gõ hàm
Lưu ý: Mã chỉ hoạt động trên hệ điều hành Window

—————————-

'                    _,
' ___   _   _  _ ___(_)
'/ __| /  | | | _ | |
'__ /  | \ | _  |
'|___/_/ _|_|_|___/_|
'
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
  Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
  Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
#If Win64 Then
  Private gTimerID As LongPtr
#Else
  Private gTimerID As Long
#End If
Private Args(), WorkIndex As Integer

Function S_AutoHide( _
  Optional ByVal Target As Range, _
  Optional ByVal WrapText As Boolean = False, _
  Optional ByVal Show As Boolean = False, _
  Optional ByVal Title$ = vbNullChar) As Variant
  On Error Resume Next
  Dim k As Integer, r, Formula$
  Set r = Application.Caller
  Formula = r(1, 1).Formula
  If Title <> vbNullChar Then
    S_AutoHide = Title & ": [" & Target.Address(0, 0) & "]"
  Else
    S_AutoHide = Mid(Formula, 2)
  End If
  k = UBound(Args)
  ReDim Preserve Args(1 To k + 1)
  Args(k + 1) = VBA.Array(0, Formula, r, Target, WrapText, Show)
  If gTimerID = 0 Then
    gTimerID = SetTimer(0&, 0&, 1, AddressOf S_AutoHide_callback)
  End If
End Function

Private Sub S_AutoHide_callback()
  On Error Resume Next
  Call KillTimer(0&, gTimerID): gTimerID = 0
  S_AutoHide_working
  On Error GoTo 0
End Sub

Private Sub S_AutoHide_working()
  On Error Resume Next
  Dim UA%, s$
  UA = UBound(Args)
  If UA > 0 Then
    WorkIndex = WorkIndex + 1
    Dim A: A = Args(WorkIndex)
    If A(0) <> 0 Or A(2).Formula <> A(1) Then
      GoTo N
    End If
    A(0) = 1
    '//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//
    Dim R1 As Range, R2 As Range, R3 As Range
    Set R1 = A(3)
    Dim RNGs As Range, i As Long, IsUp As Boolean
    Dim LR&, LC%
    LC = R1.Columns.Count
    If A(5) Then
      R1.Parent.UsedRange.EntireRow.Hidden = False
    Else
      'LR = R1.Find("*", After:=R1(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row - R1.Row + 1
      LR = R1.Rows.Count
      If LR > 0 Then
        For i = 1 To LR
          Set R2 = R1(i, 1).Resize(1, LC)
          Set R3 = R2.Find(What:="*", After:=R2(1, LC), LookIn:=xlValues, LookAt:= _
                    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
          If R3 Is Nothing Then
            If RNGs Is Nothing Then
              Set RNGs = R2
            Else
              Set RNGs = Application.Union(RNGs, R2)
            End If
          End If
        Next i

IsUp = Application.ScreenUpdating
        If Application.ScreenUpdating Then
          Application.ScreenUpdating = False
        End If
        With R1
          .EntireRow.Hidden = False
          If A(4) Then
            .WrapText = False
            .WrapText = True
          End If
        End With
        If Not RNGs Is Nothing Then
          RNGs.EntireRow.Hidden = True
        End If
        If Application.ScreenUpdating <> IsUp Then
          Application.ScreenUpdating = IsUp
        End If
      End If
    End If

Set R1 = Nothing
    Set R2 = Nothing
    Set R3 = Nothing
    Set RNGs = Nothing
    '//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//'//
N:
    If WorkIndex >= UA Then
      Erase Args: WorkIndex = 0
    Else
      gTimerID = SetTimer(0&, 0&, 1, AddressOf S_AutoHide_callback)
    End If
  End If
  On Error GoTo 0
End Sub

Tôi thấy code bạn HeSanbi viết ẩn hiện rows rất nhanh.
Cái bất tiện là phải viết hàm lại TRUE hay FALSE để nó ẩn hay hiện hàng.
Bạn có thể viết lại để kích hoạt code bằng command button giúp được không,
khi click command button thì kích hoạt code này để ẩn hàng thay vì gõ hàm như bạn đề nghị?
Rất cám ơn bạn.

Không đúng bác nhé:
Tham số Show nhận Đối số là True sẽ hiện lại toàn bộ dòng đã ẩn và hủy nhiệm vụ ẩn hiện dòng.
Chức năng này là để không phải dùng tay hiện lại tất cả các dòng đã ẩn khi không còn mục đích ẩn dòng nữa.

Nếu False thì vẫn thực hiện ẩn hiện dòng.

Nếu viết một hàm duy nhất như vậy mà bất tiện thì bác viết gọn:
=S_AutoHide(A1:F10000)
Các đối số còn lại không cần nhập