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列和1,000行，因此需要很长时间。当我试图估计上述操作所需的总时间时，我发现以下行占用了大部分时间：

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

您可以先扫描行和列，然后将其作为批处理删除，请看一下：

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

Answer 2

我设法使用如下的specialcells工作。这比以前的方法快得多，并且在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

有效删除工作表中的所有隐藏列和行

2 个答案: