加快代码删除工作表上的隐藏行 [英] Speeding Up Code that Removes Hidden Rows on a Sheet
本文介绍了加快代码删除工作表上的隐藏行的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
这是在另一个子文件中运行的，其中所有的东西，如屏幕更新和事件都被禁用。
我已经研究了加快代码的常见方法（这里：如何提高VBA宏代码的速度？，这里： http://www.databison.com/how-to-speed-up-calculation-and-improve-performance-of-excel-和-vba / ，并在此处： http://www.ozgrid.com/ VBA / SpeedingUpVBACode.htm ），但无法应用太多的。
请看看，让我知道你的想法我可以加快速度。如果还有其他正确的编码错误，请让我知道这些。
谢谢！
Sub RhidRow（ByVal count4 As Double）'count 4是可能行的总数
Dim count6，count1，count9 As Double'counter to be use
count6 = 2'从第二行开始
count1 = 0'检查可见行计数器
ActiveSheet
当count6 < count4
DoEvents
Application.StatusBar =Checking row& count6& of& count4&
如果Range（A& CStr（count6））。EntireRow.Hidden = False然后
count1 = count1 + 1'如果有可见的行，然后添加一个
End If
count6 = count6 + 1'移动到下一行以查看
Wend
范围（N7）= count6'所以我可以手动检查结果
如果count1 = 0然后'如果没有可见行，则将Z1设置为1并退出
范围（Z1）。值= 1'以在另一个子进行错误检查。如果Z1 = 1，则删除
退出子
结束如果
count6 = 2'从第2行开始
count9 = 1'count 9
count9 < count4，而行小于总行的计数
DoEvents
Application.StatusBar = count6& 或& count9& of& count4
如果范围（A& CStr（count6））。EntireRow.Hidden = True然后
范围（A& CStr（count6））。如果行被隐藏，EntireRow.Delete ，删除
Else
count6 = count6 + 1'如果没有隐藏，移动到下一行
结束如果
count9 = count9 + 1'显示它是什么行在状态栏
Wend
结束
End Sub
我已经在评论中提出了改变，并摆脱了ActiveSheet。速度不受影响。
Sub RhidRow（ByVal count4 As Double，shtO As Object）'count 4是可能的总数行
Dim count6，count1，count9 As Double'counter to be use
count6 = 2'begin on row two
count1 = 0'check for visible rows counter
与shtO
而count6< count4
DoEvents
Application.StatusBar =Checking row& count6& of& count4&
如果Range（A& CStr（count6））。EntireRow.Hidden = False然后
count1 = count1 + 1'如果有可见的行，然后添加一个
End If
count6 = count6 + 1'移动到下一行以查看
Wend
范围（N7）= count6'所以我可以手动检查结果
如果count1 = 0然后'如果没有可见行，则将Z1设置为1并退出子
范围（Z1）。值= 1'用于在另一个子进行错误检查。如果Z1为1，则表格被删除
退出Sub
结束如果
count6 = 2'从第2行开始
count9 = 1'count 9
当count9 < count4，而行小于总行的数量
DoEvents
Application.StatusBar =删除隐藏的行& count6& 或& count9& of& count4& 做了。
如果范围（A& CStr（count6））。EntireRow.Hidden = True然后
范围（A& CStr（count6））。如果行被隐藏，EntireRow.Delete ，删除它
Else
count6 = count6 + 1'如果没有隐藏，移动到下一行
结束如果
count9 = count9 + 1'显示它是什么行在状态栏中
Wend
结束
End Sub
解决方案
可能是这样的：
Sub RhidRow（ByVal count4 As Double） 4应该是一个长，不是Double
Dim count1 As Long'counter to be use
Dim ws As Worksheet
Dim rngVis As Range
Dim rngDel As Range
Set ws = ActiveSheet
On Error Resume Next
设置rngVis = ws.Range（A2：A& count4）.SpecialCells（xlCellTypeVisible）
错误GoTo 0
如果rngVis是Nothing然后
ws.Range（Z1）。值= 1
Else
对于count1 = count4到2步骤-1
如果ws.Rows（count1）.Hidden = True然后
如果rngDel不是，然后
设置rngDel = ws.Rows（count1）
Else
设置rngDel = Union（rngDel，ws.Rows（count1））
如果
结束If
Next count1
如果不是rngDel不是然后
Application.DisplayAlerts = False
相交（rngDel，rngDel.ListObject.DataBodyRange）。删除行隐藏，删除
应用程序.DisplayAlerts = True
End If
End If
End Sub
Below I have some code that I have written. It is compeletely effective and gives no errors. However, it is very, very slow. The sub takes a given sheet with a table on it and checks for hidden rows. If all the rows are hidden, it deletes the sheet. If not, then it deletes all the hidden rows.
This is run in another sub, where all things like screenupdating and events are disabled.
I have researched common ways to speed up code (here: How to improve the speed of VBA macro code?, here: http://www.databison.com/how-to-speed-up-calculation-and-improve-performance-of-excel-and-vba/, and here: http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm), but haven't been able to apply too many of them.
Please take a look and let me know what you think I could do to speed this up. If there are any other proper coding mistakes I have made, please let me know those as well.
Thanks!
Sub RhidRow(ByVal count4 As Double) 'count 4 is the total number of possible rows
Dim count6, count1, count9 As Double 'counters to be used
count6 = 2 'begin on row two
count1 = 0 'check for visible rows counter
With ActiveSheet
While count6 < count4
DoEvents
Application.StatusBar = "Checking row " & count6 & " of " & count4 & "."
If Range("A" & CStr(count6)).EntireRow.Hidden = False Then
count1 = count1 + 1 'if there was a visible row, then add one
End If
count6 = count6 + 1 'move to next row to check
Wend
Range("N7") = count6 'so I can hand check results
If count1 = 0 Then 'if there were no visible rows, then set Z1 to 1 and exit
Range("Z1").Value = 1 'to error check in another sub. if Z1=1, then delete
Exit Sub
End If
count6 = 2 'start on row 2
count9 = 1 'count 9
While count9 < count4 'while the row is less than the count of the total rows
DoEvents
Application.StatusBar = count6 & " or " & count9 & " of " & count4
If Range("A" & CStr(count6)).EntireRow.Hidden = True Then
Range("A" & CStr(count6)).EntireRow.Delete 'if row is hidden, delete
Else
count6 = count6 + 1 'if it is not hidden, move to the next row
End If
count9 = count9 + 1 'show what row it is on in the status bar
Wend
End With
End Sub
I have made the change suggested in the comments and gotten rid of ActiveSheet. The speed was unaffected.
Sub RhidRow(ByVal count4 As Double, shtO As Object) 'count 4 is the total number of possible rows
Dim count6, count1, count9 As Double 'counters to be used
count6 = 2 'begin on row two
count1 = 0 'check for visible rows counter
With shtO
While count6 < count4
DoEvents
Application.StatusBar = "Checking row " & count6 & " of " & count4 & "."
If Range("A" & CStr(count6)).EntireRow.Hidden = False Then
count1 = count1 + 1 'if there was a visible row, then add one
End If
count6 = count6 + 1 'move to next row to check
Wend
Range("N7") = count6 'so I can hand check results
If count1 = 0 Then 'if there were no visible rows, then set Z1 to 1 and exit the sub
Range("Z1").Value = 1 'this is used to error check in another sub. if Z1 is 1, then the sheet is deleted
Exit Sub
End If
count6 = 2 'start on row 2
count9 = 1 'count 9
While count9 < count4 'while the row is less than the count of the total rows
DoEvents
Application.StatusBar = "Deleting hidden rows. " & count6 & " or " & count9 & " of " & count4 & " done."
If Range("A" & CStr(count6)).EntireRow.Hidden = True Then
Range("A" & CStr(count6)).EntireRow.Delete 'if the row is hidden, delete it
Else
count6 = count6 + 1 'if it is not hidden, move to the next row
End If
count9 = count9 + 1 'show what row it is on in the status bar
Wend
End With
End Sub
解决方案
Maybe something like this:
Sub RhidRow(ByVal count4 As Double) 'count 4 should be a Long, not Double
Dim count1 As Long 'counters to be used
Dim ws As Worksheet
Dim rngVis As Range
Dim rngDel As Range
Set ws = ActiveSheet
On Error Resume Next
Set rngVis = ws.Range("A2:A" & count4).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rngVis Is Nothing Then
ws.Range("Z1").Value = 1
Else
For count1 = count4 To 2 Step -1
If ws.Rows(count1).Hidden = True Then
If rngDel Is Nothing Then
Set rngDel = ws.Rows(count1)
Else
Set rngDel = Union(rngDel, ws.Rows(count1))
End If
End If
Next count1
If Not rngDel Is Nothing Then
Application.DisplayAlerts = False
Intersect(rngDel, rngDel.ListObject.DataBodyRange).Delete 'if row is hidden, delete
Application.DisplayAlerts = True
End If
End If
End Sub
这篇关于加快代码删除工作表上的隐藏行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
