无法引用脚本运行库,如何用VBA集合替代字典实现未使用样式清理?
替换Scripting.Dictionary为VBA Collection实现清理未使用Excel样式
以下是改用VBA Collection替代Scripting.Dictionary的代码,解决无法添加「Microsoft Scripting Runtime」引用的问题:
Public Sub DropUnusedStyles() Dim styleObj As Style Dim rngCell As Range Dim wb As Workbook Dim wsh As Worksheet Dim strStyleName As String Dim iStyleCount As Long Dim colStyleNames As New Collection Dim colStyleCounts As New Collection Dim idx As Integer Set wb = ThisWorkbook ' 当前工作簿 MsgBox "清理前工作簿样式数量: " & wb.Styles.Count ' 初始化样式名称和计数集合 For Each styleObj In wb.Styles strStyleName = styleObj.NameLocal iStyleCount = iStyleCount + 1 colStyleNames.Add strStyleName colStyleCounts.Add 0 ' 初始计数为0 Next styleObj ' 统计各样式的使用次数 For Each wsh In wb.Worksheets If wsh.Visible Then For Each rngCell In wsh.UsedRange.Cells strStyleName = rngCell.Style idx = FindInCollection(colStyleNames, strStyleName) If idx > 0 Then colStyleCounts(idx) = colStyleCounts(idx) + 1 End If Next rngCell End If Next wsh ' 尝试删除未使用的样式 On Error Resume Next ' 删除样式可能报错(如内置样式无法删除) Dim i As Integer ' 倒序遍历避免集合元素删除后索引混乱 For i = colStyleNames.Count To 1 Step -1 strStyleName = colStyleNames(i) Debug.Print colStyleCounts(i) & vbTab & strStyleName If colStyleCounts(i) = 0 Then wb.Styles(strStyleName).Delete If Err.Number <> 0 Then Debug.Print vbTab & "^-- 删除失败" Err.Clear Else ' 删除成功后同步移除集合中的对应项 colStyleNames.Remove i colStyleCounts.Remove i End If End If Next i MsgBox "清理后工作簿样式数量: " & wb.Styles.Count End Sub ' 辅助函数:查找指定值在Collection中的索引,不存在则返回0 Private Function FindInCollection(col As Collection, findValue As String) As Integer Dim i As Integer FindInCollection = 0 For i = 1 To col.Count If col(i) = findValue Then FindInCollection = i Exit Function End If Next i End Function
关键改动说明
- 用两个平行的Collection替代Dictionary:
colStyleNames存储样式名称,colStyleCounts存储对应样式的使用次数,两者索引一一对应 - 新增
FindInCollection辅助函数:实现类似Dictionary的键查找功能,定位样式名称在集合中的位置,从而更新计数 - 倒序遍历集合:删除集合元素时,正序遍历会导致后续元素索引偏移,倒序遍历可避免这个问题
- 保留原代码的核心逻辑:统计样式使用次数、尝试删除未使用样式、错误处理及调试输出
内容的提问来源于stack exchange,提问作者DQd
相关产品推荐
相关产品推荐

