Es vergeht keinen Tag am Bürorechner, an welchem man nicht eine neue Fehlermeldung in Microsoft-Produkten präsentiert kriegt – und sich beim der Recherche zum Fehler wieder einmal wünschen würde, jeden einzelnen Entwickler in Redmond einen unendlich langsamen Tod sterben zu lassen.
Microsoft gibt seinen Endanwendern die grandiose Möglichkeit, jede einzelne Tabellenzeile mit einem individuellen Format zu versehen. Rahmendicke, Hintergrundfarben, Schriftschnitte können individuell definiert werden. Und jede so formatierte Zelle ergibt ein neues Zellformat, welches in der Excel-Datei zentral gesichert wird.
Das Schöne daran ist, dass es offenbar Endanwender in Schwellenländern gibt, welche es bei der Erledigung von ausgelagerten Arbeiten fertigbringen, annähernd 65’000 Formate in einer einzigen Excel-Datei mit ca. 20 Sheets unterzubringen. Heilige Shiva! Das Problem: Excel kriegt massiven Schluckauf, sobald diese Limite (wahrscheinlich mit der Grenze für unsigned integers) erreicht ist – nichts geht mehr, keine Zellformatierung, kein Zusammenführen von Zellen, ja nicht einmal kopieren geht mehr. Und dazu die lapidare Fehlermeldung:
Too many different cell formats.
Die Lösung ist im Grunde simpel: Das Dokument muss analysiert und nicht verwendete Styles gelöscht werden. Dafür gibt es mittlerweile unzählige Varianten, davon hier nur drei:
- Kommerziell. 39 Dollar will der Entwickler des Style Reduction Tools haben, damit die Excel-Endanwender wieder arbeiten und nicht Excel-Fehlermeldungen wegglicken und Abstürze überwinden müssen.
- Handgestrickt. Auf Stackoverflow findet sich VBA-Code, welchen man mit entsprechenden Kenntnissen über eine Excel-Datei laufen lassen kann. Fallstricke:
- .xlsx-Dateien müssen zuerst in .xlsm-Dateien umkonvertiert werden
- Danach muss man das Developer-Ribbon aktivieren
- Anschliessend fügt man ein Modul in die Excel-Datei ein
- Nun kopiert man den Source-Code in das Modul hinein
- Schlussendlich muss unter Tools > References noch „Microsoft Scripting Runtime“ aktiviert werden
- Jetzt kann man die Funktion starten, fliegt aber rasch auf die Schnauze, weil Dim iStyleCount As Integer als Integer definiert ist und deshalb überläuft
- Nachdem der Laptop für ca. 20-30 Minuten wie totgefroren ist, erscheint dann die erlösende Meldung: Statt der ursprünglich 64999 gefundenen Styles sind nach der Bereinigung nur noch effektiv 10 verwendete Stück im Dokument
- Beschleunigt. Da sich Microsoft des Problems bewusst ist, verlinken sie in ihrem KB-Artikel zur Fehlermeldung auf ein kostenfreies Tool eines unabhängigen Entwicklers (.NET4.0 version of the XLStylesTool is now available), welcher die Styles auf OOXML-Ebene säubert, was einen massiven Geschwindigkeitsgewinn gegenüber der VBA-Version ermöglicht. WICHTIG: Nachdem die Applikation gestartet und die Datei ausgewählt wurde, muss zwingend [x] „Commit changes …“ ausgewählt werden, damit die Anpassungen gespeichert werden können.
VBA-Code
Via: Too Many Different Cell Formats, ergänzt/überarbeitet von eMeidi.com
' Description:
' Borrowed largely from http://www.jkp-ads.com/Articles/styles06.asp
' Additional debug message piping to .txt file in C:\ by eMeidi.com
' Bugfixing iStyleCount from Integer to Long by eMeidi.com
Option Explicit
' Description:
' This is the "driver" for the entire module.
Public Sub DropUnusedStyles()
Dim styleObj As Style
Dim rngCell As Range
Dim wb As Workbook
Dim wsh As Worksheet
Dim str As String
Dim iStyleCount As Long
Dim dict As New Scripting.Dictionary ' <- from Tools / References... / "Microsoft Scripting Runtime"
' wb := workbook of interest. Choose one of the following
' Set wb = ThisWorkbook ' choose this module's workbook
Set wb = ActiveWorkbook ' the active workbook in excel
Dim strPath As String
strPath = "C:\excelFormatCleanerDebug.txt"
Dim f
f = FreeFile()
Open strPath For Output As f
'Print #f, Text
Debug.Print "BEGINNING # of styles in workbook: " & wb.Styles.Count
'GoTo Bla
' dict := list of styles
For Each styleObj In wb.Styles
str = styleObj.NameLocal
iStyleCount = iStyleCount + 1
Call dict.Add(str, 0) ' First time: adds keys
'Debug.Print str & ", ";
Print #f, str & ", "
Next styleObj
Debug.Print " dictionary now has " & dict.Count & " entries."
' Status, dictionary has styles (key) which are known to workbook
'GoTo Bla
' Traverse each visible worksheet and increment count each style occurrence
For Each wsh In wb.Worksheets
If wsh.Visible Then
For Each rngCell In wsh.UsedRange.Cells
str = rngCell.Style
dict.Item(str) = dict.Item(str) + 1 ' This time: counts occurrences
Print #f, str & "+1"
Next rngCell
End If
Next wsh
' Status, dictionary styles (key) has cell occurrence count (item)
' Try to delete unused styles
Dim aKey As Variant
On Error Resume Next ' wb.Styles(aKey).Delete may throw error
For Each aKey In dict.Keys
' display count & stylename
' e.g. "24 Normal"
Debug.Print dict.Item(aKey) & vbTab & aKey
Print #f, dict.Item(aKey) & vbTab & aKey
If dict.Item(aKey) = 0 Then
' Occurrence count (Item) indicates this style is not used
Call wb.Styles(aKey).Delete
If Err.Number <> 0 Then
Debug.Print vbTab & "^-- failed to delete"
Err.Clear
End If
Call dict.Remove(aKey)
End If
Next aKey
Debug.Print "ENDING # of style in workbook: " & wb.Styles.Count
Bla:
End Sub
