读书人

求诸位大神改下程序很简单

发布时间: 2013-08-01 15:23:18 作者: rapoo

求各位大神改下程序,很简单
就是要一个能删除excel文件中所有sheet的隐藏行和隐藏列的程序,我只找到一个删除当前sheet的程序
Sub xxx()

r = ActiveSheet.UsedRange.SpecialCells(11).Row
c = ActiveSheet.UsedRange.SpecialCells(11).Column

For rr = r To 1 Step -1
If Rows(rr).Hidden Then
Rows(rr).Delete
End If
Next

For cc = c To 1 Step -1
If Columns(cc).Hidden Then
Columns(cc).Delete
End If
Next

End Sub
改一下这个也行,别的能实现这功能也行,谢谢大家!

或者把这个删除所有隐藏行的程序改成删除所有隐藏列的也行
Dim wn As Integer
Dim rows As Integer
Dim finalrow As Integer

wn = Worksheets.Count
For ws = 1 To wn
finalrow=Worksheets(ws).[A65536].End(xlUp).Row
For rows = 1 To finalrow '删除隐藏行
If Worksheets(ws).rows(rows).Hidden = True Then
Worksheets(ws).rows(rows).Delete
rows = rows - 1 '删除第n行时下一行就是第n行,但程序已经运行到检测第n+1行,如果替补上来的行还是隐藏行将被漏删,所以给x重新赋值强制程序检测替补行
End If
Next
Next
[解决办法]


Dim wn As Integer
Dim rows As Integer
Dim finalrow As Integer
Dim cols As Integer
Dim finalcol As Integer

wn = Worksheets.Count
For ws = 1 To wn
finalrow = Worksheets(ws).[A65536].End(xlUp).Row
For rows = 1 To finalrow '删除隐藏行
If Worksheets(ws).rows(rows).Hidden = True Then
Worksheets(ws).rows(rows).Delete
rows = rows - 1 '删除第n行时下一行就是第n行,但程序已经运行到检测第n+1行,如果替补上来的行还是隐藏行将被漏删,所以给x重新赋值强制程序检测替补行
End If
Next

finalcol = Worksheets(ws).[ZZ1].End(xlToLeft).Column


For cols = 1 To finalcol '删除隐藏列
If Worksheets(ws).Columns(cols).Hidden = True Then
Worksheets(ws).Columns(cols).Delete
cols = cols - 1 '删除第n列时下一行就是第n列,但程序已经运行到检测第n+1列,如果替补上来列行还是隐藏行将被漏删,所以给x重新赋值强制程序检测替补列
End If
Next
Next


[解决办法]
没验证你代码的正确性。

在外面再包一个循环。

Sub xxx()

For Each sh In Sheets

r = sh.UsedRange.SpecialCells(11).Row
c = sh.UsedRange.SpecialCells(11).Column

For rr = r To 1 Step -1
If Rows(rr).Hidden Then
Rows(rr).Delete
End If
Next rr

For cc = c To 1 Step -1
If Columns(cc).Hidden Then
Columns(cc).Delete
End If
Next cc

Next sh

End Sub

读书人网 >VBA

热点推荐