编程技术文章分享与教程

网站首页 > 技术文章 正文

Excel VBA:一键删除自定义数字格式

hmc789 2024-11-19 05:00:57 技术文章 1 ℃

问题:

Excel工作簿内含有很多自定义数字格式,但实际并未使用。强迫症一犯起来,就想删光它们。可是Excel只能一个个删除,实在太费劲。

VBA能不能一键清理所有未使用的自定义数字格式?答案是肯定的。

先上效果图:

VBA程序效果:


Talk is cheap, show me the code.

VBA程序源码:

Sub deleteAllUnusedCustomNumberFormats(Optional wbk As Workbook) 	' v 0.0.1    ' jeffreyjcli-a-t-qq.com
    On Error Resume Next
    sPrompt = "是否删除所有自定义数字格式?" & vbCrLf & "(Delete unused custom number formats from the workbook?)"
    vAnsr = MsgBox(sPrompt, vbYesNoCancel + vbQuestion + vbDefaultButton1 + vbApplicationModal)
    Application.ScreenUpdating = False
    If vAnsr = vbCancel Or vAnsr = vbNo Then Exit Sub
    If wbk Is Nothing Then Set wbk = ActiveWorkbook
    Set wst = wbk.Sheets.Add
    Set rng = wst.Range("A2")
    rng.Select
    Do
        vSetFormat = rng.NumberFormatLocal
        DoEvents
        SendKeys "{Tab 3}{Down}{Enter}"
        Application.Dialogs(xlDialogFormatNumber).Show vSetFormat
        ReDim Preserve vCustomNumberFormats(0 To ll)
        vCustomNumberFormats(ll) = rng.NumberFormatLocal
        ll = ll + 1
    Loop Until vCustomNumberFormats(ll - 1) = vSetFormat
    vCustomNumberFormats = RemoveDuplicateArray(vCustomNumberFormats)
    sCustomNumberFormats = Join(vCustomNumberFormats, vbCrLf)
    ll = 0
    For Each ws1 In wbk.Sheets
        For Each cll In ws1.UsedRange.Cells
            If InStr(1, sCustomNumberFormats, cll.NumberFormatLocal) >= 1 Then
                ReDim Preserve vUsedCustomNumberFormats(0 To ll)
                vUsedCustomNumberFormats(ll) = cll.NumberFormatLocal
                ll = ll + 1
            End If
        Next
    Next
    vUsedCustomNumberFormats = RemoveDuplicateArray(vUsedCustomNumberFormats)
    sUsedCustomNumberFormats = Join(vUsedCustomNumberFormats, vbCrLf)
    vUnusedCustomNumberFormats = RemoveDuplicateArray(ArraySubtract(vCustomNumberFormats, vUsedCustomNumberFormats))
    sUnusedCustomNumberFormats = Join(vUnusedCustomNumberFormats, vbCrLf)
    If vAnsr = vbYes Then
        jj = 0
        For ll = LBound(vUnusedCustomNumberFormats) To UBound(vUnusedCustomNumberFormats)
            wbk.DeleteNumberFormat (vUnusedCustomNumberFormats(ll))
            If Err.Number = 0 Then
                ReDim Preserve vDeletedUnusedCustomNumberFormats(0 To jj)
                vDeletedUnusedCustomNumberFormats(jj) = vUnusedCustomNumberFormats(ll)
                jj = jj + 1
            Else
                Err.Clear
            End If
        Next
        Call MsgBox("完成。已删除以下未使用的自定义数字格式:" & vbCrLf & _
                            "Done. The following custom NumberFormats have been deleted:" & vbCrLf & vbCrLf & _
                        Join(vDeletedUnusedCustomNumberFormats, vbCrLf), _
                        vbInformation + vbYes)
    End If
    Application.ScreenUpdating = True
    If MsgBox("删除临时工作表? " & vbCrLf  & " Delete the temporary sheet?", vbYesNoCancel + vbQuestion) = vbYes Then
        Application.DisplayAlerts = False
        wst.Delete
        Application.DisplayAlerts = True
    End If
End Sub

OK. 分享完毕。


如果需要批量处理多个工作簿,或者需要插件随时在任意工作簿一键运行的话,可以私信我。

感谢您的关注、点赞、收藏与点评。下期见~


本文标题:《Excel VBA从入门到入神系列之提高篇》:Excel工作簿大瘦身:一键删除自定义数字格式

#头条创作挑战赛#

#妙笔生花创作挑战#

#Excel#

#excel#

#vba#

标签列表
最新留言