Код Excel VBA для игнорирования отфильтрованных (скрытых) строк

Question

У меня есть часть кода VB в excel, чтобы скрыть столбцы с менее чем двумя записями данных (как минимум, как минимум), и мне нужно знать, как использовать это, чтобы скрыть колонны в то время, игнорируя информацию в отфильтрованных строк:

Sub HideCols() 
Dim LC As Integer, j As Integer 
Dim cl As Range, rng As Range 

Set rng = Range("Table1").SpecialCells(xlCellTypeVisible) 

LC = Cells(3, Columns.Count).End(xlToLeft).Column 

    For j = 3 To LC 
     Columns(j).Hidden = WorksheetFunction.CountA(Columns(j)) < 2 
    Next j 


Application.ScreenUpdating = True 

End Sub 

Это то, что у меня есть, много это не имеет никакого смысла и нуждается в приведение в порядок, но это только, как я пытался найти свой путь к чему не привели ,

Спасибо!

Answer 1

Я бы как следует

Option Explicit 

Sub HideCols() 
    Dim cols As Range 
    Dim iCol As Long 

    With Range("Table1") 
     Set cols = .Resize(1, 1).Offset(, .Columns.Count + 1) 
     For iCol = 1 To .Columns.Count 
      If Application.WorksheetFunction.Subtotal(103, .Columns(iCol).SpecialCells(xlCellTypeVisible)) < 2 Then Set cols = Union(cols, .Cells(1, iCol)) 
     Next iCol 
     Set cols = Intersect(.Columns, cols) 
     If Not cols Is Nothing Then cols.EntireColumn.Hidden = True 
    End With 
End Sub 

как примечание стороны, если фильтрация выполняется из Autofilter() метода, то и заголовок строки не отфильтровываются , в этом случае вы можете захотеть изменить правый член If. Если проверка - < 3

Answer 2

Проверьте, если он скрыт первый

Sub HideCols() 
Dim LC As Integer, j As Integer 
Dim LR As Integer, curCnt as Integer 
Dim cl As Range, rng As Range 
Dim Data As Variant 

Set rng = Range("Table1").SpecialCells(xlCellTypeVisible) 

LC = Cells(3, Columns.Count).End(xlToLeft).Column 

    For j = 3 To LC 
     LR = Cells(Rows.Count, j).End(xlUp).Row 
     curCnt = 0 
     ' its faster to iterate a variant array than it is Cells 
     Data = Range(Cells(1, 1), Cells(LR, LC)) 
     for k = 1 to LR 
      if Rows(k).Hidden = False and Data(k, j) <> "" Then _ 
      curCnt = curCnt + 1 
     next k 
     Columns(j).Hidden = curCnt < 2 
    Next j 


Application.ScreenUpdating = True 

End Sub