有效地删除工作表中的所有隐藏的列和行
要删除工作表中的所有隐藏的列和行，我正在使用：
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
但下一个循环要快得多。
你有什么build议来提高执行速度吗？
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
我正在寻找使用.specialcellsselect所有可见的列，并将其撤销删除。
您可以先扫描行和列，然后按批次删除它们，看看这个：
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
此外，看看这个postfind最后一行和列： 在VBA中find最后使用的单元格的错误
我设法使用下面的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