эффективно удалить все скрытые столбцы и строки в листе

Question

Чтобы удалить все скрытые столбцы и строки в листе я использую:

With activeworkbook.Sheets(1) 

      LR = LRow(activeworkbook.Sheets(1)) ' will retrieve last row no in the sheet 
      lc = LCol(activeworkbook.Sheets(1)) ' will retrieve last column no in the sheet 

      For lp = lc To 1 Step -1 'loop through all columns 
       If .Columns(lp).EntireColumn.Hidden = True Then .Columns(lp).EntireColumn.Delete 
      Next lp 

      For lp = LR To 1 Step -1 'loop through all rows 
       If .Rows(lp).EntireRow.Hidden = True Then .Rows(lp).EntireRow.Delete 
      Next 
end with 

Но это занимает очень много времени, у меня есть более чем 300 столбцов и 1000 строк. Когда я попытался оценить общее время, необходимое для этих операций, я нашел следующие строки взяли большую часть времени:

For lp = lc To 1 Step -1 'loop through all columns 
    If .Columns(lp).EntireColumn.Hidden = True Then _ 
     .Columns(lp).EntireColumn.Delete 
Next lp 

но следующий цикл намного быстрее.

Есть ли у вас предложения по улучшению скорости выполнения?

Код для LRow и функций LCol ниже, и я подтвердить, она возвращает правильную последнюю строку и последний столбец:

Function LRow(sh As Worksheet) 
    On Error Resume Next 
    LRow = sh.Cells.Find(What:="*", _ 
          After:=sh.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          matchCase:=False).Row 
    On Error GoTo 0 
End Function 


Function LCol(sh As Worksheet) 
    On Error Resume Next 
    LCol = sh.Cells.Find(What:="*", _ 
          After:=sh.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByColumns, _ 
          SearchDirection:=xlPrevious, _ 
          matchCase:=False).Column 
    On Error GoTo 0 
End Function 

Я смотрел на использовании .specialcells для выбора всех видимых столбцов, и обратный его удаление.

Answer 1

Мне удалось заставить его работать с использованием специальных элементов, как показано ниже. Это намного быстрее, чем предыдущие методы и хорошо работает в Excel 2010 и далее.

Set urng = Activeworkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible) 
       If Not urng Is Nothing Then 
        s = Split(urng.Cells(1, 1).Address, "$") 
        LR = LRow(Activeworkbook.Sheets(1)) 
        lc = LCol(Activeworkbook.Sheets(1)) 
        icol = urng.Cells(1, 1).Column 

' delete hidden colums 
        Set urng2 = Activeworkbook.Sheets(1).Range(Cells(s(2), 1), Cells(s(2), lc)) 
        Set oVisible = urng2.SpecialCells(xlCellTypeVisible) 
        Set oHidden = urng2 

        oHidden.EntireColumn.Hidden = False 
        oVisible.EntireColumn.Hidden = True 

        Set oHidden = urng2.SpecialCells(xlCellTypeVisible) 
        oHidden.EntireColumn.Delete 
        oVisible.EntireColumn.Hidden = False 

' delete hidden rows 
        Set urng = Activeworkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible) 
        If Not urng Is Nothing Then 
         's = Split(urng.Cells(1, 1).Address, "$") 
         icol = urng.Cells(1, 1).Column 

         Set urng2 = Activeworkbook.Sheets(1).Range(Cells(1, icol), Cells(LR, icol)) 
         'urng2.Select 
         Set oVisible = urng2.SpecialCells(xlCellTypeVisible) 
         Set oHidden = urng2 

         oHidden.EntireRow.Hidden = False 
         oVisible.EntireRow.Hidden = True 

         Set oHidden = urng2.SpecialCells(xlCellTypeVisible) 
         oHidden.EntireRow.Delete 
         oVisible.EntireRow.Hidden = False 

        End If 
       End If 

Answer 2

Вы можете сканировать строки и столбцы, а затем удалять их партии, посмотрите на это:

Sub cooolboy() 

Dim Ws As Worksheet, _ 
    lp As Long, _ 
    lR As Long, _ 
    lC As Integer, _ 
    RowToDelete As String, _ 
    ColToDelete As String 

Set Ws = ActiveWorkbook.Sheets("Sheet4") 
RowToDelete = "" 
ColToDelete = "" 

With Ws 
    lR = .Range("A" & .Rows.Count).End(xlUp).Row   'will retrieve last row no in the sheet 
    lC = .Cells(1, .Columns.Count).End(xlToLeft).Column 'will retrieve last column no in the sheet 

    For lp = 1 To lC 'loop through all columns 
     If .Columns(lp).EntireColumn.Hidden Then _ 
      ColToDelete = ColToDelete & "," & Col_Letter(lp) & ":" & Col_Letter(lp) 
    Next lp 

    For lp = 1 To lR 'loop through all rows 
     If .Rows(lp).EntireRow.Hidden Then _ 
      RowToDelete = RowToDelete & "," & lp & ":" & lp 
    Next lp 
    'Get rid of the first comma 
    If ColToDelete <> "" Then ColToDelete = Right(ColToDelete, Len(ColToDelete) - 1) 
    If RowToDelete <> "" Then RowToDelete = Right(RowToDelete, Len(RowToDelete) - 1) 
    'MsgBox ColToDelete & vbCrLf & RowToDelete 
    If ColToDelete <> "" Then .Range(ColToDelete).Delete Shift:=xlToLeft 
    If RowToDelete <> "" Then .Range(RowToDelete).Delete Shift:=xlUp 
End With 

End Sub 

Function Col_Letter(lngCol As Long) As String 
Dim vArr 
vArr = Split(Cells(1, lngCol).Address(True, False), "$") 
Col_Letter = vArr(0) 
End Function 

Более того, взглянуть на этот пост для нахождения последней строки и столбца: Error in finding last used cell in VBA