Code VBA co gọn trang khi chọn Slicer

[hoahuongduong1986]

Kính gửi Anh chị và Các bạn,
Em có File kèm theo và 2 Pivot và 2 Slicer kèm theo. Có Code gì mà khi chọn bất kỳ tiêu chí nào trong slicer nó đều co lên để loại bỏ vùng trắng của trang Excel (Lấy điều kiện lọc là cột A có tích các dấu "x" ạ). Tức Filter theo cột A chọn "x" theo mỗi nhấp chuột chọn trong Slicer. Em cảm ơn anh chị ạ.

 

[hoahuongduong1986]

Kính gửi Anh chị và Các bạn,
Em có File kèm theo và 2 Pivot và 2 Slicer kèm theo. Có Code gì mà khi chọn bất kỳ tiêu chí nào trong slicer nó đều co lên để loại bỏ vùng trắng của trang Excel (Lấy điều kiện lọc là cột A có tích các dấu "x" ạ). Tức Filter theo cột A chọn "x" theo mỗi nhấp chuột chọn trong Slicer. Em cảm ơn anh chị ạ.

Có Anh/chị nào có giải pháp không ạ !

 

[tieuthubuongbinh]

Có Anh/chị nào có giải pháp không ạ !

Mình khuyên bạn là ko nên viết bài tiếp để nhờ giúp đỡ, vì khi bài đầu mà chưa có trả lời, có 1 mục filter bài chưa trả lời thì các cao thủ sẽ vào xem và giúp. Chứ bạn mà trả lời thì nó sẽ mất đi ở khu vực ấy và bài chỉ hiện lên mục new post (nhưng 1 ngày có rất nhiều new post cùng lúc nên bài càng trôi) và khi ai đó nhìn thread của bạn mà thấy hiện trả lời là <>0 thì người ta nghĩ đã có đáp án cho nên ko cần vào giúp.

Tip cho bạn là nếu sau 2 ngày mà ko ai trả lời, bạn có thể tra các nick mà có số lượng bài viết nhiều, và gửi vào trong tường nhà thành viên ấy để xin được giúp đỡ bằng cách kèm link này vào. Đương nhiên sẽ có lúc thành viên đó ko trả lời và cũng ko giúp, thì lại nhờ thành viên khác.

Chịu khó follow các bác hay online và có số lượng bài nhiều. Thường thì ko có bài trả lời có thể ko ai biết (rất ít khi do bài bị trôi).

Mình sẽ nhắn giúp bạn 1 bác chuyên về pivot, nhưng mình cũng ko quen bác ấy nên ko chắc giúp được bạn nhé.

 

[ptm0412]

Bạn chép code này vào sheet Pivot, xóa cột A đi, nhìn thấy gớm:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.ScreenUpdating = False
ActiveSheet.Rows.Hidden = False

Dim LastRow As Long, Rws As Long
LastRow = [B1000].End(xlUp).Row
Rws = ActiveSheet.Rows.Count
For i = 1 To LastRow
    If Len(Cells(i, 2)) = 0 Then Cells(i, 2).EntireRow.Hidden = True
Next
Rows(LastRow + 1 & ":" & Rws).Hidden = True
Application.ScreenUpdating = True
End Sub

Mình sẽ nhắn giúp bạn 1 bác chuyên về pivot, nhưng mình cũng ko quen bác ấy nên ko chắc giúp được bạn nhé.

Sao lại không quen? quen quá đi í chứ