本文介绍了加快代码删除工作表上的隐藏行的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧! 问题描述 下面我有一些我写的代码。它是非常有效的,没有错误。但是,这非常非常慢。子包含一个给定的表格,并在其上检查隐藏的行。如果所有行都被隐藏,它将删除该工作表。如果没有,那么它将删除所有隐藏的行。 这是在另一个子文件中运行的,其中所有的东西,如屏幕更新和事件都被禁用。 我已经研究了加快代码的常见方法(这里:如何提高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 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 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 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 rowsDim 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 WithEnd SubI 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 rowsDim count6, count1, count9 As Double 'counters to be usedcount6 = 2 'begin on row twocount1 = 0 'check for visible rows counterWith 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 WendEnd WithEnd 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 IfEnd Sub 这篇关于加快代码删除工作表上的隐藏行的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!
09-15 05:53