Excelの未使用ユーザースタイルを簡単に削除する

Excel のユーザースタイルは 「XLStylesTool」 を使用することで削除可能ですが、ユーザースタイルを削除するたびに毎回外部ツールを使用しなければならないのはちょっと不便でした。

この投稿では外部ツールやマクロを使用しないで、未使用のユーザースタイルを削除する方法を紹介します。 （動作環境は Windows 10 Pro 64bit, Excel 2013 32 bit です。）

手順は 3 ステップ

1. すべてのシートを選択。



2. 移動またはコピーを選択。



3. 移動先ブック名に「新しいブック」を選択し、「コピーを作成する」をチェック。

このようにすると「新しいブック」には使用中の「ユーザースタイル」のみが引き継がれることになり、結果として未使用のユーザースタイルを削除することができます。

実際に未使用のユーザースタイルを削除する例を紹介します。

対象ファイルのワークブック中に存在するユーザースタイルを、マクロを使って数えたところ 41778 個のユーザースタイルが登録されていることがわかります。

セルのスタイルメニューを開くと、このように多くのユーザースタイルが表示されています。

このワークブックの中で使用しているユーザースタイルを、先日作成した 「Excel のユーザースタイルの使用状況を調べるマクロ」 で調査したところ 41778 個のユーザースタイルの内、実際に使用しているスタイルは標準22のひとつだけで、残り 41777 個のユーザースタイルは全て未使用であることを確認しました。

ここで前述の手順どおり 「新しいブック」 にすべてのシートをコピーして、未使用のユーザースタイルを削除します。ユーザースタイルの削除後 「新しいブック」 のセルのスタイルメニューを開くと、ユーザースタイルの項目は標準22だけが残り、未使用のユーザースタイルが全て削除されたことがわかります。

改めてマクロで確認しても、使用中のユーザースタイルが一つだけであることがわかります。

マクロの処理速度の違い

大量のユーザースタイルはマクロの処理速度に大きく影響を与える場合があります。たとえばユーザースタイル (4,000 個以上) が登録されているブックの中で罫線のLineStyleを標準の太さ以外に変更しようとしたとき、マクロの処理速度が大きく低下する経験をしました。 このような場合、未使用のユーザースタイルを削除することによってマクロの処理速度が向上することがあります。

次の動画は、上記のユーザースタイルの削除前と削除後におけるマクロの処理速度を比較しています。

テスト環境:
CPU: Intel Core i5-2540M 2.60 GHz, RAM: 16 GB,
Windows 10 Pro 64 bit, Excel 2013, Excel 2003 SP3

ユーザースタイルの削除前

（描画処理完了まで約 35 秒要しています）

ユーザースタイルの削除後

（描画処理は約 12 秒で完了） 削除前と比較して 3 倍速くなりました。

Excel 2003 の場合

参考までに、同じアドインを使用した Excel 2003 の処理速度はさらに高速でした。 （描画処理は約 6 秒で完了）削除前と比較して 6 倍速いです。これを今まで使用していました。

注： Excel 2003 のスタイル数は最大 4,000 までのため、事前に XLStylesTool を使用してユーザースタイルを削除しています。

おわりに

Excel 2007 以前のセルスタイルは 4,000 まで使用できましたが、Excel 2007 で 拡張されて最大 64,000 まで使用できるようになりました。 それに伴い 「Excel 2007 で、使用されていないスタイルが、あるブックから別のブックへコピーされます。 - KB2553085」 のような、意図しないスタイルの増加のトラブルなどでユーザースタイルが 4,000 を超えてしまうと 「Word/Excel/PowerPoint 用 Microsoft Office 互換機能パック」 を使用して Excel 2000 や 2003 で xlsx 形式のファイルを開くことができないトラブルが起こりましたが、このような場合は「XLStylesTool」を使用することでユーザースタイルを削除することが可能でした。

そのため、これまでの作業の流れは次のようになっていました。

1. 作業対象ファイル.xlsx を取得
2. XLStylesTool でスタイル削除
3. Office 互換機能パックで変換後 Excel 2003 で開きマクロを実行

既に 2 年前の事ですが、Excel 2003 の延長サポートの終了が残り 1 年となったこともあり Excel 2013 へ移行しようとしました。ところが Excel 2013 ではマクロの処理速度が余りにも遅く、移行をためらうことになりました。結局 Excel 2003 を使い続けることに。

今年になって Windows 10 へ移行したこともあって改めて Excel 2013 に切り替えるべく試行錯誤しているなかで今回の解決方法が見つかりました。 これで安心して Excel 2013 に移行することができます。

関連する過去の投稿

• Excelのユーザースタイルの使用状況を調べるマクロ
• Excel　スタイル設定一覧を、シートに表示するマクロ
• Office 互換機能パックでxlsxファイルが開けない。

Excelワークブックに登録されたスタイルを数えるマクロ。

	'ワークブックのスタイルをカウント
	Sub count_workbook_styles()
	On Error Resume Next
	Dim bltin_count As Long
	Dim not_bltin_count As Long
	Dim s As Style
	Dim bk As Workbook
	Set bk = ActiveWorkbook
	bltin_count = 0
	not_bltin_count = 0
	For Each s In bk.Styles
	If s.BuiltIn Then
	bltin_count = bltin_count + 1
	Else
	not_bltin_count = not_bltin_count + 1
	End If
	Next
	Debug.Print "Builtin= " & bltin_count & ", NotBuiltin= " & not_bltin_count
	End Sub

view raw count_workbook_styles.bas hosted with ❤ by GitHub

メモ：特定の範囲をMathJaxにレンダリングさせない方法

ブログで MathJax を使用できるように設定していると数式表示がとても便利になるのですが、ちょっと具合の悪い場合もあります。それは、数式に解釈できる文字列を含んだ Gist のコードを貼り付けた場合です。

例えばこのように、数式の部分が自動的に変換されて表示されます。

	<h1>オイラーの公式</h1>
	<p>$e^{i\theta} = \cos\theta + i\sin\theta$</p>

view raw eulers_formula.html hosted with ❤ by GitHub

これを回避するには、MathJax の ignoreClass を使用します。

以下のように MathJax.Hub.Config の設定にignoreClass: "tex2jax_ignore"を追加すると。MathJax にレンダリングさせないクラスを設定することができます。

MathJax.Hub.Config({
    
    ...
    
    tex2jax: {

        ...

        ignoreClass: "tex2jax_ignore"
    }
});

コードのスクリプトを張り付ける際は、下記のようにclass="tex2jax_ignore"のブロックで囲みます。

<div class="tex2jax_ignore">
<script src="https://gist.github.com/icm7216/8409c6e4e7332a03ef5747f7f030fd58.js"></script>
</div>

これで MathJax にレンダリングされず、そのまま表示できるようになります。

	<h1>オイラーの公式</h1>
	<p>$e^{i\theta} = \cos\theta + i\sin\theta$</p>

view raw eulers_formula.html hosted with ❤ by GitHub

Excelのユーザースタイルの使用状況を調べるマクロ

Excel のユーザースタイルの使用状況を調べるマクロを作りました。ユーザースタイルを適用している、ワークシートやセルアドレスを知ることができます。以前に作った「スタイル設定をシートに出力する　VBAマクロ」の兄弟ツールになります。

結果は新しいシートに表示されます。この一覧ではユーザースタイルが適用されているシート名、セルアドレス、セルの内容、ユーザースタイル名、ユーザースタイルの設定内容などを表示します。

Excel のワークシート内で使用しているユーザースタイルを調査します。

使い方

1. 調査対象のワークブックを開く。
2. VBAプロジェクトの標準モジュールにModule_Debug_Styles.basを登録。
3. user_style_inspectorを実行。

発見したユーザースタイルは新しいシートに表示されます。

コードはいくつかのプロシージャに分かれていますがuser_style_inspectorが本体です。

文字コードに注意！

Gistにアップロードしているファイルエンコードは便宜上UTF-8になっています。しかしながら、VBAプロジェクトの保存ファイルのファイルエンコードはShift_JISが使用されています。そのため、VBAプロジェクトにModule_Debug_Styles.basをインポートする場合は、事前に文字コードを変換する必要があります。（文字化けします）

文字コードの変換にはテキストエディタや変換ツールなどを使用しますが、面倒な場合はブラウザ上のコードをコピペするなどして工夫してください。

view raw how_to_use.md hosted with ❤ by GitHub

	Attribute VB_Name = "Module_Debug_Styles"
	Option Private Module
	Option Explicit
	'このモジュールは、デバッグ用。
	'-------------------------------------------------------------------------------
	'
	'ユーザースタイルの構造体
	'
	'20160607 作成
	'
	Public Type CellStyle
	SheetName As String ' 0: シート名
	A1 As String ' 1: 位置 (セルアドレス A1形式)
	CellText As String ' 2: セルの値
	BuiltIn As String ' 3: スタイルの種類 "組み込み" or "ユーザー"
	StyleName As String ' 4: スタイル名
	IncludeNumber As String ' 5: 表示形式
	VerticalAlignment As String ' 6: 配置縦 xlVAlign
	HorizontalAlignment As String ' 7: 配置横 XlHAlign
	FontName As String ' 8: フォント名
	FontSize As String ' 9: フォントサイズ
	BorderLeft As String '10: 罫線左
	BorderRight As String '11: 罫線右
	BorderTop As String '12: 罫線上
	BorderBottom As String '13: 罫線下
	BorderDiagonalDown As String '14: 罫線右斜め下
	BorderDiagonalUp As String '15: 罫線右斜め上
	Patterns As String '16: パターン XlPattern
	Locked As String '17: 保護 ロック
	FormulaHidden As String '18: 保護 非表示
	End Type
	'
	'セルアドレスの数値部分を指定した桁数でフォーマットする
	'
	'引数: A1形式の文字列、行番号にあたる数値部分の桁数。
	'戻り値: 数値部分をフォーマットしたセルアドレスの文字列
	'
	'使用例: セルアドレス"B3"を3桁でフォーマットする場合
	' conv_a01("B3",3) # => "B003"
	'
	'20160606 作成。セルアドレス順にソートするために作成。
	'
	Function conv_a01(mystr As String, num_length As Long) As String
	On Error Resume Next
	Dim reg As Object
	Dim match As Object
	Dim matches As Object
	Dim num_str As String
	'正規表現オブジェクトを作成
	Set reg = CreateObject("VBScript.RegExp")
	With reg
	.Pattern = "([A-Za-z]+)([0]*)([0-9]+)"
	.IgnoreCase = False
	.Global = True
	End With
	If Len(mystr) <= 0 Then
	conv_a01 = ""
	Exit Function
	End If
	'A1形式の文字列を検索
	Set matches = reg.Execute(mystr)
	'マッチしたコレクションを置換
	For Each match In matches
	num_str = Format(match.submatches(2), String(num_length, "0"))
	mystr = reg.Replace(mystr, "$1" & num_str)
	Next match
	conv_a01 = mystr
	End Function
	'
	'指定したセル範囲のスタイルを調査する。
	'
	'引数: 調査するセル範囲 range型
	'戻り値: CellStyle構造体の配列
	'
	'20160607 作成。スタイル調査部分を独立させた。
	'
	Function get_cell_style(myrange As Range) As CellStyle()
	On Error Resume Next
	Dim style_tmp As String
	Dim style_val As Long
	Dim border_pos As Integer
	Dim border(5) As String
	Dim r As Range
	Dim i As Long
	Dim border_xl As Variant
	border_xl = Array(xlLeft, xlRight, xlTop, xlBottom, xlDiagonalDown, xlDiagonalUp)
	Dim border_name As Variant
	border_name = Array("左", "右", "上", "下", "右斜め下", "右斜め上")
	'スタイル格納用の配列
	Dim cs() As CellStyle
	ReDim cs(myrange.Count)
	i = 0
	For Each r In myrange
	' 0: シート名
	cs(i).SheetName = r.Parent.Name
	' 1: 位置 (セルアドレス)
	cs(i).A1 = r.Address(0, 0)
	' 2: セルの値
	cs(i).CellText = r.Text
	' 3: 種類 "ユーザー"
	If r.Style.BuiltIn Then
	'組込みスタイル
	style_tmp = "組込"
	Else
	'ユーザースタイル
	style_tmp = "ユーザー"
	End If
	cs(i).BuiltIn = style_tmp
	' 4: スタイル名
	cs(i).StyleName = r.Style.NameLocal
	' 5: 表示形式
	If r.Style.IncludeNumber Then
	style_tmp = r.NumberFormatLocal
	Else
	style_tmp = "-"
	End If
	cs(i).IncludeNumber = style_tmp
	'配置
	If r.Style.IncludeAlignment Then
	' 6: 配置縦 xlVAlign
	style_val = r.Style.VerticalAlignment
	Select Case style_val
	Case xlVAlignTop
	style_tmp = "上"
	Case xlVAlignCenter
	style_tmp = "中央"
	Case xlVAlignBottom
	style_tmp = "下"
	Case xlVAlignJustify
	style_tmp = "両端揃え"
	Case xlVAlignDistributed
	style_tmp = "均等割り付け"
	Case Else
	style_tmp = ""
	End Select
	cs(i).VerticalAlignment = style_tmp
	' 7: 配置横 XlHAlign
	style_val = r.Style.HorizontalAlignment
	Select Case style_val
	Case xlHAlignGeneral
	style_tmp = "標準"
	Case xlHAlignLeft
	style_tmp = "左"
	Case xlHAlignCenter
	style_tmp = "中央"
	Case xlHAlignRight
	style_tmp = "右"
	Case xlHAlignFill
	style_tmp = "繰り返し"
	Case xlHAlignJustify
	style_tmp = "両端揃え"
	Case xlHAlignCenterAcrossSelection
	style_tmp = "選択範囲で中央"
	Case xlHAlignDistributed
	style_tmp = "均等割り付け"
	Case Else
	style_tmp = ""
	End Select
	cs(i).HorizontalAlignment = style_tmp
	Else
	cs(i).VerticalAlignment = "-"
	cs(i).HorizontalAlignment = "-"
	End If
	'フォント
	If r.Style.IncludeFont Then
	' 8: フォント名
	cs(i).FontName = r.Style.Font.Name
	' 9: フォントサイズ
	cs(i).FontSize = r.Style.Font.Size
	Else
	cs(i).FontName = "-"
	cs(i).FontSize = "-"
	End If
	'罫線　XlLineStyle
	If r.Style.IncludeBorder Then
	For border_pos = 0 To 5
	style_val = r.Style.Borders(border_xl(border_pos)).LineStyle
	If style_val <> xlLineStyleNone Then
	border(border_pos) = border_name(border_pos)
	Else
	border(border_pos) = "なし"
	End If
	Next border_pos
	cs(i).BorderLeft = border(0) '10: 罫線左
	cs(i).BorderRight = border(1) '11: 罫線右
	cs(i).BorderTop = border(2) '12: 罫線上
	cs(i).BorderBottom = border(3) '13: 罫線下
	cs(i).BorderDiagonalDown = border(4) '14: 罫線右斜め下
	cs(i).BorderDiagonalUp = border(5) '15: 罫線右斜め上
	Else
	cs(i).BorderLeft = "-"
	cs(i).BorderRight = "-"
	cs(i).BorderTop = "-"
	cs(i).BorderBottom = "-"
	cs(i).BorderDiagonalDown = "-"
	cs(i).BorderDiagonalUp = "-"
	End If
	'16: パターン XlPattern
	If r.Style.IncludePatterns Then
	If r.Style.Interior.Pattern = xlPatternNone Then
	style_tmp = "網かけなし"
	Else
	style_tmp = "網かけ"
	End If
	Else
	style_tmp = "-"
	End If
	cs(i).Patterns = style_tmp
	'保護
	If r.Style.IncludeProtection Then
	'17: 保護 ロック
	If r.Style.Locked Then
	style_tmp = "ロック"
	Else
	style_tmp = ""
	End If
	cs(i).Locked = style_tmp
	'18: 保護 非表示
	If r.Style.FormulaHidden Then
	style_tmp = "表示しない"
	Else
	style_tmp = "表示"
	End If
	cs(i).FormulaHidden = style_tmp
	Else
	cs(i).Locked = "-"
	cs(i).FormulaHidden = "-"
	End If
	i = i + 1
	Next r
	get_cell_style = cs()
	End Function
	'
	'ワークブック内で使用しているユーザースタイルを調査。その結果を新しいシートに表示する｡
	'一覧をシート名順、セルアドレス順にソート。
	'
	'20160608 作成。セルスタイルの調査をget_cell_style()で行うようにした。
	'
	Sub user_style_inspector()
	On Error GoTo ERROR_STYLE
	With Application
	'画面更新停止
	.ScreenUpdating = False
	'自動再計算を停止
	.Calculation = xlManual
	End With
	Dim sheet As Worksheet
	Dim row_max As Long
	Dim col_max As Long
	Dim r1 As Long
	Dim c1 As Long
	Dim r1c1_str As String
	Dim a1_str As String
	Dim mycell As Range
	Dim max_length As Long
	Dim bltin_count As Long
	Dim not_bltin_count As Long
	Dim n As Long
	Dim i As Long
	Dim cs() As CellStyle
	Dim tmp() As Variant
	Dim list_title As Variant
	list_title = Array("シート名", "位置", "セルの値", "種類", "スタイル名", _
	"表示形式", "配置 縦", "配置 横", "フォント名", "サイズ", _
	"罫線", "罫線", "罫線", "罫線", "罫線", _
	"罫線", "パターン", "保護", "数式表示")
	n = 0
	max_length = 0
	ReDim Preserve tmp(18, n)
	For Each sheet In ActiveWorkbook.Sheets
	With sheet.Range("A1").SpecialCells(xlLastCell)
	row_max = .row
	col_max = .Column
	End With
	Debug.Print "sheet name = " & sheet.Name
	r1 = 1
	While r1 <= row_max
	c1 = 1
	While c1 <= col_max
	Set mycell = sheet.Cells(r1, c1)
	If mycell.Style.BuiltIn Then
	'組込みスタイル
	bltin_count = bltin_count + 1
	Else
	'ユーザースタイル
	not_bltin_count = not_bltin_count + 1
	'セルアドレス変換
	r1c1_str = "R" & r1 & "C" & c1
	a1_str = Application.ConvertFormula(r1c1_str, xlR1C1, xlA1, xlRelative)
	'ユーザースタイルが適用されているセルの、行の値の最大値の桁数を取得
	If Len(CStr(r1)) > max_length Then
	max_length = Len(CStr(r1))
	End If
	'セルのスタイルを取得
	ReDim Preserve tmp(18, n)
	i = mycell.Count - 1
	ReDim cs(i)
	cs = get_cell_style(mycell)
	tmp(0, n) = cs(i).SheetName ' 0: シート名
	tmp(1, n) = cs(i).A1 ' 1: 位置 (セルアドレス)
	tmp(2, n) = cs(i).CellText ' 2: セルの値
	tmp(3, n) = cs(i).BuiltIn ' 3: 種類 "ユーザー"
	tmp(4, n) = cs(i).StyleName ' 4: スタイル名
	tmp(5, n) = cs(i).IncludeNumber ' 5: 表示形式
	tmp(6, n) = cs(i).VerticalAlignment ' 6: 配置縦 xlVAlign
	tmp(7, n) = cs(i).HorizontalAlignment ' 7: 配置横 XlHAlign
	tmp(8, n) = cs(i).FontName ' 8: フォント名
	tmp(9, n) = cs(i).FontSize ' 9: フォントサイズ
	tmp(10, n) = cs(i).BorderLeft '10: 罫線左
	tmp(11, n) = cs(i).BorderRight '11: 罫線右
	tmp(12, n) = cs(i).BorderTop '12: 罫線上
	tmp(13, n) = cs(i).BorderBottom '13: 罫線下
	tmp(14, n) = cs(i).BorderDiagonalDown '14: 罫線右斜め下
	tmp(15, n) = cs(i).BorderDiagonalUp '15: 罫線右斜め上
	tmp(16, n) = cs(i).Patterns '16: パターン XlPattern
	tmp(17, n) = cs(i).Locked '17: 保護 ロック
	tmp(18, n) = cs(i).FormulaHidden '18: 保護 非表示
	n = n + 1
	End If
	c1 = c1 + 1
	Wend
	r1 = r1 + 1
	Wend
	Debug.Print "組み込みスタイル = " & bltin_count & ", ユーザースタイル = " & not_bltin_count
	bltin_count = 0
	not_bltin_count = 0
	Next sheet
	'ユーザースタイルが無ければ終了
	If tmp(0, 0) = "" Then
	With Application
	'自動再計算を自動に
	.Calculation = xlAutomatic
	'画面更新開始
	.ScreenUpdating = True
	End With
	Exit Sub
	End If
	'ユーザースタイル使用セルの一覧を出力
	Dim sh As Worksheet
	Set sh = ActiveWorkbook.Worksheets.Add
	Dim table_rc As Range
	Dim table_i As Long
	Dim table_row As Long
	Dim table_col As Long
	table_row = UBound(tmp, 2) + 1
	table_col = UBound(tmp, 1) + 1
	'タイトル表示
	sh.Range("a1").Resize(1, UBound(list_title) + 1).Value = list_title
	'調査結果の配列tmpをセルへ書き込む
	sh.Range("A2").Resize(table_row, table_col) = WorksheetFunction.Transpose(tmp)
	'セルアドレスをフォーマット
	Dim r As Range
	For Each r In sh.Range("B2").Resize(table_row)
	r.Value = conv_a01(r.Value, max_length)
	Next r
	'sort:　シート名：昇順、　位置：昇順、　先頭行：タイトル
	With sh.Range("A1").Resize(table_row + 1, table_col)
	.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), Order2:=xlAscending, Header:=xlYes, MatchCase:=False
	.Font.Size = 9
	.Columns.AutoFit
	End With
	'セルの値の列幅
	sh.Columns(3).ColumnWidth = 20
	'セルの値を表示
	For table_i = 2 To table_row + 1
	Set table_rc = sh.Range("A" & table_i)
	Worksheets(table_rc.Text).Range(table_rc.Offset(0, 1).Text).Copy Destination:=table_rc.Offset(0, 2)
	Next table_i
	Erase tmp
	With Application
	'自動再計算を自動に
	.Calculation = xlAutomatic
	'画面更新開始
	.ScreenUpdating = True
	End With
	Exit Sub
	ERROR_STYLE:
	'エラー時の画面更新の復帰処理
	With Application
	'自動再計算を自動に
	.Calculation = xlAutomatic
	'画面更新開始
	.ScreenUpdating = True
	End With
	r1c1_str = "R" & r1 & "C" & c1
	Debug.Print "error cell = " & Application.ConvertFormula(r1c1_str, xlR1C1, xlA1, xlRelative)
	End Sub
	'-------------------------------------------------------------------------------
	'
	'get_cell_style()のテスト
	'
	'引数に、セル範囲を指定する場合
	'
	Sub test_get_cell_style()
	Dim r_count As Long
	Dim cs() As CellStyle
	Dim i As Long
	Dim mycell As Range
	Set mycell = Range("A1:C3")
	r_count = mycell.Count - 1
	ReDim cs(r_count)
	cs = get_cell_style(mycell)
	For i = 0 To r_count
	Debug.Print "位置 (セルアドレス) = " & cs(i).A1
	Debug.Print "セルの値 = " & cs(i).CellText
	Debug.Print "種類 = " & cs(i).BuiltIn
	Debug.Print "スタイル名 = " & cs(i).StyleName
	Next i
	End Sub

view raw Module_Debug_Styles.bas hosted with ❤ by GitHub