「とりあえずこのまま使う」前に。引き継いだExcelブックを最初に整える3つのマクロ
タグ:
ExcelVBA業務効率化Tips初心者
投稿先: Qiita
前任者のブックは、なぜか触るたびに何かが引っかかる
異動や引き継ぎで受け取ったExcelブック。開いてみると、使われていない名前定義がエラーだらけで残っていたり、データの入っていない空シートが何枚も挟まっていたり、コピペを繰り返した跡で書式がバラバラになっていたり——中身は動くのに、なぜか触るたびに何かが引っかかる。そんな経験がある人は多いはずです。
ここまで読んでいるということは、あなたも「前任者のブックを開いて一瞬固まった」経験があるのではないでしょうか。この記事では、引き継いだブックを触る前にまず実行しておきたい、棚卸し・整理のための3つのマクロを、実際のコードとともに紹介します。
1. 使われなくなった名前定義を一括削除する
ClearAllNamedRangesは、ブック内に定義されたすべての名前付き範囲を確認ダイアログ付きで一括削除するマクロです。他ブックからシートをコピーした際に紛れ込む不要な名前定義や、参照先が消えて#REF!エラーになっている名前の掃除に向いています。
Sub ClearAllNamedRanges()
Dim wb As Workbook
Dim nm As Name
Dim countDeleted As Long
Dim nmNames() As String
Dim i As Long
On Error GoTo ErrorHandler
Set wb = ActiveWorkbook
If wb.Names.Count = 0 Then
MsgBox "名前定義は存在しません。", vbInformation
Exit Sub
End If
If MsgBox("すべての名前定義 (" & wb.Names.Count & "件) を削除しますか?" & vbCrLf & "この操作は元に戻せません。", _
vbYesNo + vbExclamation, "名前定義全削除") = vbNo Then
Exit Sub
End If
ReDim nmNames(1 To wb.Names.Count)
i = 1
For Each nm In wb.Names
nmNames(i) = nm.Name
i = i + 1
Next nm
countDeleted = 0
For i = 1 To UBound(nmNames)
On Error Resume Next
wb.Names(nmNames(i)).Delete
If Err.Number = 0 Then
countDeleted = countDeleted + 1
End If
On Error GoTo ErrorHandler
Next i
MsgBox countDeleted & " 件の名前定義を削除しました。", vbInformation
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub
数式内で参照されている名前を誤って削除すると#NAME?エラーが発生するため、実行前に一覧を確認しておくと安全です。ブックレベルとシートレベルで削除方法がわずかに異なる点も注意しておくと事故を防げます。
2. データの入っていない空シートをまとめて削除する
DeleteEmptySheetsは、UsedRangeを確認して実質的にデータが存在しないシートを検出し、確認後にまとめて削除するマクロです。テンプレートから大量生成したシートのうち実際には使われなかったもの、検証用に作って放置されたシートの整理に効果的です。
Sub DeleteEmptySheets()
Dim ws As Worksheet
Dim emptySheets As Collection
Dim sheetName As String
Dim confirmMsg As String
Dim i As Long
Dim keepAtLeastOne As Boolean
On Error GoTo ErrorHandler
Set emptySheets = New Collection
For Each ws In Worksheets
If IsSheetEmpty(ws) Then
emptySheets.Add ws.Name
End If
Next ws
If emptySheets.Count = 0 Then
MsgBox "空のシートはありません。", vbInformation
Exit Sub
End If
confirmMsg = "以下の空シートを削除します:" & vbCrLf & vbCrLf
For i = 1 To emptySheets.Count
confirmMsg = confirmMsg & " " & i & ": " & emptySheets(i) & vbCrLf
Next i
confirmMsg = confirmMsg & vbCrLf & "宜しいですか?"
If Worksheets.Count - emptySheets.Count < 1 Then
MsgBox "すべてのシートが空白です。全削除は禁止されています。", vbExclamation
Exit Sub
End If
If MsgBox(confirmMsg, vbYesNo + vbExclamation, "空シート削除") = vbNo Then
Exit Sub
End If
Application.DisplayAlerts = False
For i = emptySheets.Count To 1 Step -1
Worksheets(emptySheets(i)).Delete
Next i
Application.DisplayAlerts = True
MsgBox emptySheets.Count & "枚の空シートを削除しました。", vbInformation
Exit Sub
ErrorHandler:
Application.DisplayAlerts = True
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub
Private Function IsSheetEmpty(ws As Worksheet) As Boolean
Dim usedRange As Range
Set usedRange = ws.UsedRange
If usedRange Is Nothing Then
IsSheetEmpty = True
Exit Function
End If
If Application.WorksheetFunction.CountA(usedRange) = 0 Then
IsSheetEmpty = True
Else
IsSheetEmpty = False
End If
End Function
最低1枚のシートは残す安全策が入っているため、実行ミスで全シートが消える心配はありません。削除前に対象シート名をログに残しておけば、誤って必要なシートを消してしまった場合の判断材料にもなります。
3. バラバラになった書式を標準に戻す
ResetCellStylesは、選択したセル範囲の書式(フォント・背景色・罫線・数値書式・配置など)を初期状態にリセットするマクロです。複数人がそれぞれの流儀で書式を変更してきたシートや、コピペを繰り返して不要な書式が混入したシートを整理する第一歩として使えます。
Sub ResetCellStyles()
On Error GoTo ErrorHandler
Dim rng As Range
If TypeName(Selection) <> "Range" Then
MsgBox "セル範囲を選択してから実行してください", vbCritical, "エラー"
Exit Sub
End If
Set rng = Selection
rng.Style = "Normal"
MsgBox "スタイルを標準にリセットしました", vbInformation, "完了"
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました:" & vbCrLf & Err.Description, vbCritical, "エラー"
End Sub
値や数式は保持されたまま書式だけが初期化されるため、データを消してしまう心配はありません。条件付き書式は対象外なので、完全にリセットしたい場合は別途条件付き書式を解除するマクロと組み合わせるのがおすすめです。
まとめ: 引き継いだら、まず「地面をならす」
3つに共通するのは、どれも「壊れているものを直す」のではなく「散らかっているものを片付ける」マクロだということです。前任者のブックを触る前にこの3つを実行しておくだけで、後から出てくる#NAME?エラーや謎の空シート、書式崩れに悩まされるリスクをかなり減らせます。
紹介したClearAllNamedRanges・DeleteEmptySheets・ResetCellStylesを含む、VBAマクロを100本、サイトにまとめて公開しています。
