You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

无法引用脚本运行库,如何用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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.22 03:15:36