Code xóa toàn bộ các dòng và cột ẩn (ẩn = Filter) của tất cả các sheet trong 1 file (1 người xem)

[AnhThu-1976]

Thầy/cô, anh/chị cho em hỏi có Code nào xóa toàn bộ các dòng và cột ẩn của tất cả các sheet trong 1 file?
Em cảm ơn!

 

[HieuCD]

Bạn cho hỏi thêm có cách nào xóa luôn các dòng hay cột đang Group (đang Group, nghĩa là đang ở chế độ hide )không?

Có file thì có thể làm được

 

[AnhThu-1976]

Có file thì có thể làm được

Ví dụ file có 2 sheet có group và 1 sheet không group, và mỗi sheet được group khác nhau!

 

[HieuCD]

Ví dụ file có 2 sheet có group và 1 sheet không group, và mỗi sheet được group khác nhau!

Code của mình xóa được mà, bạn chạy thử

 

[phulien1902]

Bạn cho hỏi thêm có cách nào xóa luôn các dòng hay cột đang Group (đang Group, nghĩa là đang ở chế độ hide )không?

Bạn thử:

Sub Del_Rows()
    Dim i, LR, Rng
    Set Rng = ActiveSheet.UsedRange
    LR = Rng.Rows.Count
    For i = 1 To LR
        If Rng.Rows(i).OutlineLevel > 1 Then
            Rng.Rows(i).EntireRow.Delete
            i = i - 1
        End If
    Next
End Sub
Sub Del_Colums()
    Dim i, LC, Rng
    Set Rng = ActiveSheet.UsedRange
    LC = Rng.Columns.Count
    For i = 1 To LC
        If Rng.Columns(i).OutlineLevel > 1 Then
            Rng.Columns(i).EntireColumn.Delete
            i = i - 1
        End If
    Next
End Sub

 

[ndu96081631]

Chạy code

Sub GPE()
  Dim Ws As Worksheet, i As Long
  Dim cRng As Range, rRng As Range
  For Each Ws In ThisWorkbook.Worksheets
    With Ws.UsedRange
      For i = 1 To .Columns.Count
        If .Cells(1, i).EntireColumn.Hidden = True Then
          If cRng Is Nothing Then Set cRng = .Cells(1, i) Else Set cRng = Union(cRng, .Cells(1, i))
        End If
      Next i
      For i = 1 To .Rows.Count
        If .Cells(i, 1).EntireRow.Hidden = True Then
          If rRng Is Nothing Then Set rRng = .Cells(i, 1) Else Set rRng = Union(rRng, .Cells(i, 1))
        End If
      Next i
      If Ws.FilterMode = True Then Ws.ShowAllData
      If Not cRng Is Nothing Then cRng.EntireColumn.Delete: Set cRng = Nothing
      If Not rRng Is Nothing Then rRng.EntireRow.Delete: Set rRng = Nothing
    End With
  Next Ws
End Sub

Thật ra với gợi ý ở bài trên của mình thì không cần phải for next gì cả

 

[HieuCD]

Thật ra với gợi ý ở bài trên của mình thì không cần phải for next gì cả

Cách nầy rất hay, tính để cho bạn ra tay cho trọn vẹn . Bạn gợi ý nên mình viết luôn

Sub GPE()
  Dim Ws As Worksheet, i As Long
  Dim Rng As Range, tmpRng As Range
  On Error Resume Next
  For Each Ws In ThisWorkbook.Worksheets
    With Ws.UsedRange
      Set Rng = .SpecialCells(xlCellTypeVisible)
      If Ws.FilterMode = True Then Ws.ShowAllData
      .EntireColumn.Hidden = False
      Rng.EntireRow.Hidden = False
      
      Rng.EntireColumn.Hidden = True
      .SpecialCells(xlCellTypeVisible).EntireColumn.Delete
      Rng.EntireColumn.Hidden = False
      
      Rng.EntireRow.Hidden = True
      .SpecialCells(xlCellTypeVisible).EntireRow.Delete
      Rng.EntireRow.Hidden = False
    End With
  Next Ws
  On Error GoTo 0
End Sub

 

[AnhThu-1976]

Bạn thử:

Sub Del_Rows()
    Dim i, LC, Rng
    Set Rng = ActiveSheet.UsedRange
    LR = Rng.Rows.Count
    For i = 1 To LR
        If Rng.Rows(i).OutlineLevel > 1 Then
            Rng.Rows(i).EntireRow.Delete
            i = i - 1
        End If
    Next
End Sub
Sub Del_Colums()
    Dim i, LC, Rng
    Set Rng = ActiveSheet.UsedRange
    LC = Rng.Columns.Count
    For i = 1 To LC
        If Rng.Columns(i).OutlineLevel > 1 Then
            Rng.Colums(i).EntireColumn.Delete
            i = i - 1
        End If
    Next
End Sub

Khi chạy code thì báo lỗi "Run time error 438" "Object doesn't support this property or method "
tại dòng

Rng.Colums(i).EntireColumn.Delete

Tôi đã google để khắc phục nhưng không được, nhờ bạn hướng dẫn thêm!

 

[phulien1902]

Khi chạy code thì báo lỗi "Run time error 438" "Object doesn't support this property or method "
tại dòng

Rng.Colums(i).EntireColumn.Delete

Tôi đã google để khắc phục nhưng không được, nhờ bạn hướng dẫn thêm!

Bạn để ý hình dưới đóng khung màu đỏ thiếu chữ n.

Vậy bây giờ bạn sửa Colums ----> Columns, vậy thôi.

 

[ndu96081631]

Cách nầy rất hay, tính để cho bạn ra tay cho trọn vẹn . Bạn gợi ý nên mình viết luôn

Sub GPE()
  Dim Ws As Worksheet, i As Long
  Dim Rng As Range, tmpRng As Range
  On Error Resume Next
  For Each Ws In ThisWorkbook.Worksheets
    With Ws.UsedRange
      Set Rng = .SpecialCells(xlCellTypeVisible)
      If Ws.FilterMode = True Then Ws.ShowAllData
      .EntireColumn.Hidden = False
      Rng.EntireRow.Hidden = False
    
      Rng.EntireColumn.Hidden = True
      .SpecialCells(xlCellTypeVisible).EntireColumn.Delete
      Rng.EntireColumn.Hidden = False
    
      Rng.EntireRow.Hidden = True
      .SpecialCells(xlCellTypeVisible).EntireRow.Delete
      Rng.EntireRow.Hidden = False
    End With
  Next Ws
  On Error GoTo 0
End Sub

Có vài vấn đề cần bàn:
1> Vấn đề 1:
SpecialCells khá tốn năng lượng nên phải tính toán tối ưu. Ví dụ ta có 1000 dòng x 10 cột, trong đó có 100 ẩn, vậy ta còn lại 900 dòng hiện. Khi ấy SpecialCells(xlCellTypeVisible) sẽ tính toán trên 900 x 10 = 9000 cells
Mà như ta đã biết thì 1 dòng bị ẩn thì tất cả các cells trên dòng đó cũng ẩn. Vậy có phải ta xét cell đầu tiên thôi sẽ tiết kiệm hơn không? Tức thay vì:

 .SpecialCells(xlCellTypeVisible)

Ta sửa thành:

.resize(,1).SpecialCells(xlCellTypeVisible)

thì theo ví dụ trên SpecialCells chỉ tính toán trên 900 cells mà thôi (thay vì 9000 cells)
2> Vấn đề 2:
Dòng trên bảng tính bị ẩn bởi nhiều nguyên nhân. Nếu muốn giải quyết tất cả thì ta nên viết Function/Sub làm từng công việc cụ thể chứ không nên "ôm đồm" mọi thứ
-------------------------------
Từ những ý trên tôi sẽ viết 1 Sub có tham số truyền để giải quyết riêng cho chuyện xóa dòng ẩn khi filter như sau:

Private Sub DelInvisibleFilter(ByVal SourceRange As Range)
  Dim rngFilter As Range
  On Error Resume Next
  With SourceRange
    If .Parent.FilterMode = False Then Exit Sub
    If .Rows.Count < 3 Then Exit Sub
    Application.ScreenUpdating = False
    Set rngFilter = .Resize(, 1).SpecialCells(xlCellTypeVisible)
    .Parent.ShowAllData
    rngFilter.EntireRow.Hidden = True
    .Resize(, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .EntireRow.Hidden = False
  End With
  Application.ScreenUpdating = True
End Sub

Sub Main()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Worksheets
    DelInvisibleFilter wks.UsedRange
  Next
End Sub

Với bài toán xóa cột ẩn cũng sẽ làm gần tương tự

 

[huuthang_bd]

Có vài vấn đề cần bàn:
1> Vấn đề 1:
SpecialCells khá tốn năng lượng nên phải tính toán tối ưu. Ví dụ ta có 1000 dòng x 10 cột, trong đó có 100 ẩn, vậy ta còn lại 900 dòng hiện. Khi ấy SpecialCells(xlCellTypeVisible) sẽ tính toán trên 900 x 10 = 9000 cells
Mà như ta đã biết thì 1 dòng bị ẩn thì tất cả các cells trên dòng đó cũng ẩn. Vậy có phải ta xét cell đầu tiên thôi sẽ tiết kiệm hơn không? Tức thay vì:

 .SpecialCells(xlCellTypeVisible)

Ta sửa thành:

.resize(,1).SpecialCells(xlCellTypeVisible)

thì theo ví dụ trên SpecialCells chỉ tính toán trên 900 cells mà thôi (thay vì 9000 cells)
2> Vấn đề 2:
Dòng trên bảng tính bị ẩn bởi nhiều nguyên nhân. Nếu muốn giải quyết tất cả thì ta nên viết Function/Sub làm từng công việc cụ thể chứ không nên "ôm đồm" mọi thứ
-------------------------------
Từ những ý trên tôi sẽ viết 1 Sub có tham số truyền để giải quyết riêng cho chuyện xóa dòng ẩn khi filter như sau:

Private Sub DelInvisibleFilter(ByVal SourceRange As Range)
  Dim rngFilter As Range
  On Error Resume Next
  With SourceRange
    If .Parent.FilterMode = False Then Exit Sub
    If .Rows.Count < 3 Then Exit Sub
    Application.ScreenUpdating = False
    Set rngFilter = .Resize(, 1).SpecialCells(xlCellTypeVisible)
    .Parent.ShowAllData
    rngFilter.EntireRow.Hidden = True
    .Resize(, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .EntireRow.Hidden = False
  End With
  Application.ScreenUpdating = True
End Sub

Sub Main()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Worksheets
    DelInvisibleFilter wks.UsedRange
  Next
End Sub

Với bài toán xóa cột ẩn cũng sẽ làm gần tương tự

Nếu chỉ xét 1 cột thì anh phải đảm bảo cột đó đang không ẩn.
Ngoài ra, SpecialCells rất tiện nhưng nếu dữ liệu lớn sẽ không dùng được.

 

[HieuCD]

Có vài vấn đề cần bàn:
1> Vấn đề 1:
SpecialCells khá tốn năng lượng nên phải tính toán tối ưu. Ví dụ ta có 1000 dòng x 10 cột, trong đó có 100 ẩn, vậy ta còn lại 900 dòng hiện. Khi ấy SpecialCells(xlCellTypeVisible) sẽ tính toán trên 900 x 10 = 9000 cells
Mà như ta đã biết thì 1 dòng bị ẩn thì tất cả các cells trên dòng đó cũng ẩn. Vậy có phải ta xét cell đầu tiên thôi sẽ tiết kiệm hơn không? Tức thay vì:

 .SpecialCells(xlCellTypeVisible)

Ta sửa thành:

.resize(,1).SpecialCells(xlCellTypeVisible)

thì theo ví dụ trên SpecialCells chỉ tính toán trên 900 cells mà thôi (thay vì 9000 cells)
2> Vấn đề 2:
Dòng trên bảng tính bị ẩn bởi nhiều nguyên nhân. Nếu muốn giải quyết tất cả thì ta nên viết Function/Sub làm từng công việc cụ thể chứ không nên "ôm đồm" mọi thứ
-------------------------------
Từ những ý trên tôi sẽ viết 1 Sub có tham số truyền để giải quyết riêng cho chuyện xóa dòng ẩn khi filter như sau:

Private Sub DelInvisibleFilter(ByVal SourceRange As Range)
  Dim rngFilter As Range
  On Error Resume Next
  With SourceRange
    If .Parent.FilterMode = False Then Exit Sub
    If .Rows.Count < 3 Then Exit Sub
    Application.ScreenUpdating = False
    Set rngFilter = .Resize(, 1).SpecialCells(xlCellTypeVisible)
    .Parent.ShowAllData
    rngFilter.EntireRow.Hidden = True
    .Resize(, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .EntireRow.Hidden = False
  End With
  Application.ScreenUpdating = True
End Sub

Sub Main()
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Worksheets
    DelInvisibleFilter wks.UsedRange
  Next
End Sub

Với bài toán xóa cột ẩn cũng sẽ làm gần tương tự

Mình nghỉ nên bỏ dòng lệnh
If .Rows.Count < 3 Then Exit Sub
Vì có khả năng như trong file