xin code tự động hide dòng trống chạy nhanh

Kid_vui_tinh · 27/2/20

Chào mn,
Mình có một file cần hide các dòng trống, mình có dùng 1 code trong file nhưng như vậy hide từng dòng sẽ lâu nếu nhiều dòng trống
Đồng thời mình muốn tự động xuống dòng ở ô đã merge nếu nội dung quá dài và ô đó là ô lấy thông tin từ ô khác
Các cao nhân cho mình giúp mình xây code nào làm nhanh hơn đc ko?
Cảm ơn mn!

thuanfun · 27/2/20

Mình test code này với 10k dòng thì trên máy mình chạy gần 1 giây.

Mã:

Sub hide()

    Application.ScreenUpdating = False
    
    With Sheets("sheet1")
        For i = 3 To .UsedRange.Rows.count
            If IsEmpty(.Cells(i, 1).value) Then
                .Cells(i, 1).EntireRow.Hidden = True
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True

End Sub

Kid_vui_tinh · 28/2/20

thuanfun đã viết:
Mình test code này với 10k dòng thì trên máy mình chạy gần 1 giây.

Mã:

Sub hide() Application.ScreenUpdating = False With Sheets("sheet1") For i = 3 To .UsedRange.Rows.count If IsEmpty(.Cells(i, 1).value) Then .Cells(i, 1).EntireRow.Hidden = True End If Next i End With Application.ScreenUpdating = True End Sub

Cảm ơn bác để mình thử!
Vậy còn vđ xuống dòng ae giúp vs =)))

thuanfun · 28/2/20

Kid_vui_tinh đã viết:
Cảm ơn bác để mình thử!
Vậy còn vđ xuống dòng ae giúp vs =)))

Bạn gán thuộc tính Cells(x, y).WrapText = True cho các ô cần xuống dòng.

Kid_vui_tinh · 28/2/20

thuanfun đã viết:
Bạn gán thuộc tính Cells(x, y).WrapText = True cho các ô cần xuống dòng.

Mình thử r nhưng ko hoạt động bác ơi @@
Vấn đề này có vẻ nan giải.
Nếu mình active vào cái dòng đấy thì nó sẽ tự xuống nhưng mà là dòng ăn hàm từ chỗ khác nên ô đó ko tự nhảy đc dù value vẫn đổi

thuanfun · 28/2/20

Kid_vui_tinh đã viết:
Mình thử r nhưng ko hoạt động bác ơi @@
Vấn đề này có vẻ nan giải.
Nếu mình active vào cái dòng đấy thì nó sẽ tự xuống nhưng mà là dòng ăn hàm từ chỗ khác nên ô đó ko tự nhảy đc dù value vẫn đổi

Mình Test trên máy mình thì thấy nó vẫn WrapText (xuống dòng), tuy nhiên nó gặp vấn đề ở chỗ không tự động giãn (độ cao) của dòng để có thể thấy được đầy đủ nội dung. Bạn kiểm tra trên máy tính bạn có phải như vậy không?

Kid_vui_tinh · 28/2/20

thuanfun đã viết:
Mình Test trên máy mình thì thấy nó vẫn WrapText (xuống dòng), tuy nhiên nó gặp vấn đề ở chỗ không tự động giãn (độ cao) của dòng để có thể thấy được đầy đủ nội dung. Bạn kiểm tra trên máy tính bạn có phải như vậy không?

Đó chính xác là vấn đề mình muốn đề cập đó bác =))

HeSanbi · 28/2/20

Nếu bạn muốn sử dụng hàm tự động hoàn toàn thì thử Code dưới đây

A1 = AutoHideEmptyRowsAndWrapText(A2:A10000, B1)
B1 = True hoặc False : False thì dừng và bỏ ẩn

Copy code dưới vào một Module
----------------

PHP:

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
Private AHERW_RangeStart As Range, AHERW_TimerID&, AHERW_AutoHide As Boolean

Function AutoHideEmptyRowsAndWrapText(ByVal RangeStart As Range, Optional ByVal AutoHide As Boolean = True) As String
  Set AHERW_RangeStart = RangeStart
  AHERW_AutoHide = AutoHide
  If AHERW_TimerID <> 0 Then KillTimer 0&, AHERW_TimerID
  AHERW_TimerID = SetTimer(0&, 0&, 1, AddressOf AutoHideEmptyRowsAndWrapText_Callback)
  AutoHideEmptyRowsAndWrapText = "AutoHide"
End Function

Sub AutoHideEmptyRowsAndWrapText_Callback()

  On Error Resume Next
  KillTimer 0&, AHERW_TimerID: AHERW_TimerID = 0

  Set AHERW_RangeStart = AHERW_RangeStart(1, 1)
  Dim RNGAs As Range, RNGBs As Range, I As Long, IsUp As Boolean
  IsUp = Application.ScreenUpdating
  Application.ScreenUpdating = False
  With AHERW_RangeStart.Parent
    If Not AHERW_AutoHide Then
      .UsedRange.EntireRow.Hidden = False
    Else
      For I = AHERW_RangeStart.Row + VBA.IIf(AHERW_RangeStart.Row <= 1, 1, 0) To .UsedRange.Rows.Count
        If VBA.IsEmpty(.Cells(I, AHERW_RangeStart.Column).Value) Then
          If RNGBs Is Nothing Then
            Set RNGBs = .Cells(I, AHERW_RangeStart.Column)
          Else
            Set RNGBs = Application.Union(RNGBs, .Cells(I, AHERW_RangeStart.Column))
          End If
        Else
          If RNGAs Is Nothing Then
            Set RNGAs = .Cells(I, AHERW_RangeStart.Column)
          Else
            Set RNGAs = Application.Union(RNGAs, .Cells(I, AHERW_RangeStart.Column))
          End If
        End If
      Next I
      If Not RNGAs Is Nothing Then
        With RNGAs
          .EntireRow.Hidden = False
          .WrapText = False
          .WrapText = True
        End With
      End If
      If Not RNGBs Is Nothing Then
        RNGBs.EntireRow.Hidden = True
      End If
    End If
  End With
  Set AHERW_RangeStart = Nothing
  Application.ScreenUpdating = IsUp
End Sub

HeSanbi · 28/2/20

----------------
A1 = AutoHideEmptyRowsAndWrapText(A2:D10000, B1)

*Lưu ý: Mặc dù nhập A2 vẫn được thực hiện, nhưng khi giá trị trong mảng thay đổi thì hàm không chạy vì vậy phải nhập đầy đủ mảng A2:D10000

Đoạn code dưới đây sẽ xét nguyên một hàng có Empty hay không
----------------

PHP:

Sub AutoHideEmptyRowsAndWrapText_Callback()
  On Error Resume Next
  KillTimer 0&, AHERW_TimerID: AHERW_TimerID = 0
  Set AHERW_RangeStart = AHERW_RangeStart(1, 1)
  Dim RNGs As Range, RNGAs As Range, RNGBs As Range, I As Long, IsUp As Boolean
  IsUp = Application.ScreenUpdating
  Application.ScreenUpdating = False
  With AHERW_RangeStart.Parent
    If Not AHERW_AutoHide Then
      .UsedRange.EntireRow.Hidden = False
    Else
      Dim RNG As Range, K As Long
      Set RNGs = .UsedRange: K = RNGs.Columns.Count
      For I = AHERW_RangeStart.Row To .UsedRange.Rows.Count
        Set RNG = Nothing
        Set RNG = RNGs(I, 1).Resize(, K).Find("*")
        If RNG Is Nothing Then
          If RNGBs Is Nothing Then
            Set RNGBs = RNGs(I, 1)
          Else
            Set RNGBs = Application.Union(RNGBs, RNGs(I, 1))
          End If
        Else
          If RNGAs Is Nothing Then
            Set RNGAs = RNGs(I, 1).Resize(, K)
          Else
            Set RNGAs = Application.Union(RNGAs, RNGs(I, 1).Resize(, K))
          End If
        End If
      Next I
      If Not RNGAs Is Nothing Then
        With RNGAs
          .EntireRow.Hidden = False
          .WrapText = False
          .WrapText = True
        End With
      End If
      If Not RNGBs Is Nothing Then
        RNGBs.EntireRow.Hidden = True
      End If
    End If
  End With
  Set AHERW_RangeStart = Nothing
  Set RNGAs = Nothing
  Set RNGBs = Nothing
  Set RNG = Nothing
  Set RNGs = Nothing
  Application.ScreenUpdating = IsUp
End Sub

Kid_vui_tinh · 29/2/20

HeSanbi đã viết:

----------------
A1 = AutoHideEmptyRowsAndWrapText(A2:D10000, B1)

*Lưu ý: Mặc dù nhập A2 vẫn được thực hiện, nhưng khi giá trị trong mảng thay đổi thì hàm không chạy vì vậy phải nhập đầy đủ mảng A2:D10000

Đoạn code dưới đây sẽ xét nguyên một hàng có Empty hay không
----------------

PHP:

Sub AutoHideEmptyRowsAndWrapText_Callback()
  On Error Resume Next
  KillTimer 0&, AHERW_TimerID: AHERW_TimerID = 0
  Set AHERW_RangeStart = AHERW_RangeStart(1, 1)
  Dim RNGs As Range, RNGAs As Range, RNGBs As Range, I As Long, IsUp As Boolean
  IsUp = Application.ScreenUpdating
  Application.ScreenUpdating = False
  With AHERW_RangeStart.Parent
    If Not AHERW_AutoHide Then
      .UsedRange.EntireRow.Hidden = False
    Else
      Dim RNG As Range, K As Long
      Set RNGs = .UsedRange: K = RNGs.Columns.Count
      For I = AHERW_RangeStart.Row To .UsedRange.Rows.Count
        Set RNG = Nothing
        Set RNG = RNGs(I, 1).Resize(, K).Find("*")
        If RNG Is Nothing Then
          If RNGBs Is Nothing Then
            Set RNGBs = RNGs(I, 1)
          Else
            Set RNGBs = Application.Union(RNGBs, RNGs(I, 1))
          End If
        Else
          If RNGAs Is Nothing Then
            Set RNGAs = RNGs(I, 1).Resize(, K)
          Else
            Set RNGAs = Application.Union(RNGAs, RNGs(I, 1).Resize(, K))
          End If
        End If
      Next I
      If Not RNGAs Is Nothing Then
        With RNGAs
          .EntireRow.Hidden = False
          .WrapText = False
          .WrapText = True
        End With
      End If
      If Not RNGBs Is Nothing Then
        RNGBs.EntireRow.Hidden = True
      End If
    End If
  End With
  Set AHERW_RangeStart = Nothing
  Set RNGAs = Nothing
  Set RNGBs = Nothing
  Set RNG = Nothing
  Set RNGs = Nothing
  Application.ScreenUpdating = IsUp
End Sub

Mình thử nhưng ko hoạt động bác ạ
B có thể làm luôn trong file mình đính kèm đc ko?

be_09 · 29/2/20

thuanfun đã viết:
Bạn gán thuộc tính Cells(x, y).WrapText = True cho các ô cần xuống dòng.

Bạn không đọc kỹ bài 1 rồi, người có nêu thế này "tự động xuống dòng ở ô đã merge".
Nhưng bài 1 không nêu rõ ràng, đúng ra phải nêu thế này "tự động xuống dòng ở ô đã merge và co giản dòng theo dữ liệu", ba cái vụ này nó không đơn giản đâu.

HeSanbi · 29/2/20

Kid_vui_tinh đã viết:
Mình thử nhưng ko hoạt động bác ạ
B có thể làm luôn trong file mình đính kèm đc ko?

--------------------

Chỉ việc copy vào Module trong trình chỉnh sử VBE là thực hiện được:

Copy từ #8
#9 là copy thay thế thủ tục trong #8 nếu cần.

Nếu bạn chưa biết sử dụng VBA thì học cách sử dụng VBA trước.

xin code tự động hide dòng trống chạy nhanh

Kid_vui_tinh

Thành viên mới

File đính kèm

thuanfun

Thành viên chính thức

File đính kèm

Kid_vui_tinh

Thành viên mới

thuanfun

Thành viên chính thức

Kid_vui_tinh

Thành viên mới

thuanfun

Thành viên chính thức

Kid_vui_tinh

Thành viên mới

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Kid_vui_tinh

Thành viên mới

be_09

Biên Hòa, Đồng Nai

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian