EXCELer

Tanto quanto sei, o limite de formatos no Excel, pouco ultrapassará os 200.

E os formatos customizados (pessoais), mesmo que já não funcionem, têm a
tendência para se manterem.

Pode experimentar-se um procedimento de VBA, elaborado por Leo Heuser, que
limpa os formatos que não são utilizados:


Sub DeleteUnusedCustomNumberFormats()
Dim Buffer As Object
Dim Sh As Object
Dim SaveFormat As Variant
Dim fFormat As Variant
Dim nFormat() As Variant
Dim xFormat As Long
Dim incr As Long
Dim incr1 As Long
Dim incr2 As Long
Dim StartRow As Long
Dim EndRow As Long
Dim Dummy As Variant
Dim pPresent As Boolean
Dim NumberOfFormats As Long
Dim Answer
Dim c As Object
Dim DataStart As Long
Dim DataEnd As Long
Dim AnswerTxt As String

NumberOfFormats = 1000
ReDim nFormat(0 To NumberOfFormats)
AnswerTxt = "Do you want to delete unused formats from this book?"
AnswerTxt = AnswerTxt & Chr(10) & _
"To get a list of used and unused formats only, choose No."
Answer = MsgBox(AnswerTxt, 259)
If Answer = vbCancel Then GoTo Finito

On Error GoTo Finito
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "CustomFormats"
Worksheets("CustomFormats").Activate
Set Buffer = Range("A2")
Buffer.Select
nFormat(0) = Buffer.NumberFormatLocal
incr = 1
Do
SaveFormat = Buffer.NumberFormatLocal
Dummy = Buffer.NumberFormatLocal
DoEvents
SendKeys "{tab 3}{down}{enter}"
Application.Dialogs(xlDialogFormatNumber).Show Dummy
nFormat(incr) = Buffer.NumberFormatLocal
incr = incr + 1
Loop Until nFormat(incr - 1) = SaveFormat

ReDim Preserve nFormat(0 To incr - 2)

Range("A1").Value = "Custom formats"
Range("B1").Value = "Formats used in workbook"
Range("C1").Value = "Formats not used"
Range("A1:C1").Font.Bold = True

StartRow = 3
EndRow = 16384

For incr = 0 To UBound(nFormat)
Cells(StartRow, 1).Offset(incr, 0).NumberFormatLocal = _
nFormat(incr)
Cells(StartRow, 1).Offset(incr, 0).Value = nFormat(incr)
Next incr

incr = 0
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Name = "CustomFormats" Then Exit For
For Each c In Sh.UsedRange.Cells
fFormat = c.NumberFormatLocal
If Application.WorksheetFunction.CountIf( _
Range(Cells(StartRow, 2), Cells(EndRow, 2)), fFormat) = 0 Then
Cells(StartRow, 2).Offset(incr, 0).NumberFormatLocal = fFormat
Cells(StartRow, 2).Offset(incr, 0).Value = fFormat
incr = incr + 1
End If
Next c
Next Sh

xFormat = Range(Cells(StartRow, 2), Cells(EndRow, 2)). _
Find("").Row - 2
incr2 = 0
For incr = 0 To UBound(nFormat)
pPresent = False
For incr1 = 1 To xFormat
If nFormat(incr) = Cells(StartRow, 2).Offset( _
incr1, 0).NumberFormatLocal Then
pPresent = True
End If
Next incr1
If pPresent = False Then
Cells(StartRow, 3).Offset(incr2, 0). _
NumberFormatLocal = nFormat(incr)
Cells(StartRow, 3).Offset(incr2, 0).Value = nFormat(incr)
incr2 = incr2 + 1
End If
Next incr
With ActiveSheet.Columns("A:C")
.AutoFit
.HorizontalAlignment = xlLeft
End With
If Answer = vbYes Then
DataStart = Range(Cells(1, 3), Cells(EndRow, 3)).Find("").Row + 1
DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1
On Error Resume Next
For Each c In Range(Cells(DataStart, 3), Cells(DataEnd, 3)).Cells
ActiveWorkbook.DeleteNumberFormat (c.NumberFormat)
Next c
End If
Finito:
Set c = Nothing
Set Sh = Nothing
Set Buffer = Nothing
End Sub