1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

「とりあえずこのまま使う」前に。引き継いだExcelブックを最初に整える3つのマクロ

1
Posted at

「とりあえずこのまま使う」前に。引き継いだExcelブックを最初に整える3つのマクロ

タグ: Excel VBA 業務効率化 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?エラーや謎の空シート、書式崩れに悩まされるリスクをかなり減らせます。

紹介したClearAllNamedRangesDeleteEmptySheetsResetCellStylesを含む、VBAマクロを100本、サイトにまとめて公開しています。

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?