删除没有颜色的工作表,从所有工作表中删除评论,断开所有来源的链接
Delete Sheets With No Color, Remove Comments from All Sheets, Break Links to All Sources
我目前正在开发我的第一个 VBA 宏,以 运行 标题中描述的功能。我目前有以下代码。
它似乎按预期工作,但如果我有任何意想不到的后果,或者是否有更稳定的方法来编写它,我希望有第二双眼睛告诉我。提前致谢,KP。
'
' deletecomments Macro
' delete comments, removetabs, break links for rolling models
'
' Keyboard Shortcut: Ctrl+alt+R
'
Public Sub RollModel()
Dim ws As Worksheet, cmt As Comment
For Each ws In ActiveWorkbook.Worksheets
For Each cmt In ws.Comments
cmt.Delete
Next cmt
Next ws
On Error Resume Next
For Each it In ThisWorkbook.LinkSources
For Each sh In Sheets
sh.Cells.Replace it, ""
For Each cl In sh.UsedRange.SpecialCells(-4174)
If InStr(cl.Validation.Formula1, "#REF") Then cl.Validation.Delete
Next
Next
ThisWorkbook.BreakLink it, 1
Next
Application.DisplayAlerts = False
Dim Sht As Worksheet
For Each Sht In Worksheets
If Sht.Tab.ColorIndex = xlColorIndexNone Then Sht.Delete
Next
Application.DisplayAlerts = True
End Sub
我相信其他人可以给你更好的答案,但这只是我注意到的一些事情。
- 未声明的变量被视为变体
- 下一个错误恢复将抑制所有错误 -- 而不仅仅是您试图忽略的错误
Sheets
集合可以包括图表工作表(如果工作簿中存在),而 Worksheets
不包括。
另外,对于错误的格式,我们深表歉意。写在手机上。未经测试。
Option Explicit
Public Sub RollModel()
With thisworkbook
Dim ws As Worksheet
For Each ws In .Worksheets
Ws.cells.clearcomments
Next ws
' I assume your on error resume next was because when there are no LinkSources, vbempty is returned instead of an array -- which you can't iterate over '
' Also, this method can also return a 2 dimensional array according to https://docs.microsoft.com/en-us/office/vba/api/excel.workbook.linksources -- which would cause an error as array indexes below are one-dimensional '
Dim linkArray as variant
Linkarray = .linksources
Dim linkIndex as long
Dim cell as range
If not isempty(linkarray) then
For linkIndex = Lbound(linkarray) to ubound(linkarray)
For Each ws In .Worksheets
Ws.cells.replace linkarray(linkIndex), ""
For Each cell In ws.cells.SpecialCells(xlCellTypeAllValidation)
If InStr(cell.Validation.Formula1, "#REF") Then
cl.Validation.Delete ' Not sure if this is the best way/approach, so have not really changed it.'
End if
Next cell
Next ws
.BreakLink linkarray(linkIndex), xlLinkTypeExcelLinks
Next linkIndex
End if
For Each ws In .Worksheets
If ws.Tab.ColorIndex = xlColorIndexNone Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Next ws
End With
End Sub
我目前正在开发我的第一个 VBA 宏,以 运行 标题中描述的功能。我目前有以下代码。
它似乎按预期工作,但如果我有任何意想不到的后果,或者是否有更稳定的方法来编写它,我希望有第二双眼睛告诉我。提前致谢,KP。
'
' deletecomments Macro
' delete comments, removetabs, break links for rolling models
'
' Keyboard Shortcut: Ctrl+alt+R
'
Public Sub RollModel()
Dim ws As Worksheet, cmt As Comment
For Each ws In ActiveWorkbook.Worksheets
For Each cmt In ws.Comments
cmt.Delete
Next cmt
Next ws
On Error Resume Next
For Each it In ThisWorkbook.LinkSources
For Each sh In Sheets
sh.Cells.Replace it, ""
For Each cl In sh.UsedRange.SpecialCells(-4174)
If InStr(cl.Validation.Formula1, "#REF") Then cl.Validation.Delete
Next
Next
ThisWorkbook.BreakLink it, 1
Next
Application.DisplayAlerts = False
Dim Sht As Worksheet
For Each Sht In Worksheets
If Sht.Tab.ColorIndex = xlColorIndexNone Then Sht.Delete
Next
Application.DisplayAlerts = True
End Sub
我相信其他人可以给你更好的答案,但这只是我注意到的一些事情。
- 未声明的变量被视为变体
- 下一个错误恢复将抑制所有错误 -- 而不仅仅是您试图忽略的错误
Sheets
集合可以包括图表工作表(如果工作簿中存在),而Worksheets
不包括。
另外,对于错误的格式,我们深表歉意。写在手机上。未经测试。
Option Explicit
Public Sub RollModel()
With thisworkbook
Dim ws As Worksheet
For Each ws In .Worksheets
Ws.cells.clearcomments
Next ws
' I assume your on error resume next was because when there are no LinkSources, vbempty is returned instead of an array -- which you can't iterate over '
' Also, this method can also return a 2 dimensional array according to https://docs.microsoft.com/en-us/office/vba/api/excel.workbook.linksources -- which would cause an error as array indexes below are one-dimensional '
Dim linkArray as variant
Linkarray = .linksources
Dim linkIndex as long
Dim cell as range
If not isempty(linkarray) then
For linkIndex = Lbound(linkarray) to ubound(linkarray)
For Each ws In .Worksheets
Ws.cells.replace linkarray(linkIndex), ""
For Each cell In ws.cells.SpecialCells(xlCellTypeAllValidation)
If InStr(cell.Validation.Formula1, "#REF") Then
cl.Validation.Delete ' Not sure if this is the best way/approach, so have not really changed it.'
End if
Next cell
Next ws
.BreakLink linkarray(linkIndex), xlLinkTypeExcelLinks
Next linkIndex
End if
For Each ws In .Worksheets
If ws.Tab.ColorIndex = xlColorIndexNone Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Next ws
End With
End Sub