入力規則に違反するセルを一覧表示するVBAマクロ

Excelで入力規則に違反するセルを一覧表示するVBAマクロの作成方法

Excelのデータ整合性を保つためには、データの入力規則が重要な役割を果たします。しかし、大規模なシートでは、これらの規則に違反するセルを見つけるのが難しい場合があります。この記事では、入力規則に違反するセルを効率的に見つけ出し、新しいシートに一覧表示するVBAマクロの作成方法を紹介します。

マクロの特徴

このマクロは、ワークブック内の全シートを走査し、入力規則に違反しているセルの情報（シート名、セルアドレス、セルの値）を新しいシートに一覧表示します。さらに、違反セルへのハイパーリンクを含めることで、直接そのセルにジャンプできる便利さを提供します。また、同名のシートが存在する場合は自動で新しいシート名を生成し、エラーを防ぎます。

コードの挿入方法

以下のコードをExcelのVBAエディタに挿入します。具体的な手順は後述します。

Sub ListInvalidDataWithHyperlinks()
    Dim ws As Worksheet, newSheet As Worksheet
    Dim cell As Range, r As Long
    Dim sheetName As String, cellAddress As String, cellValue As String
    Dim newSheetName As String
    Dim hyperlinkAddress As String

    ' 新しいシート名を決定
    newSheetName = "Invalid Data List"
    If SheetExists(newSheetName) Then
        newSheetName = GetUniqueName(newSheetName)
    End If

    ' 新しいシートを作成し、タイトル行を設定
    Set newSheet = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
    newSheet.Name = newSheetName
    newSheet.Cells(1, 1).Value = "Sheet Name"
    newSheet.Cells(1, 2).Value = "Cell Address"
    newSheet.Cells(1, 3).Value = "Cell Value"
    newSheet.Cells(1, 4).Value = "Hyperlink"

    r = 2 ' データの開始行

    ' ワークブックの各シートをループ
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> newSheet.Name Then
            For Each cell In ws.UsedRange
                ' セルが入力規則に違反しているかチェック
                If Not cell.Validation.Value Then
                    sheetName = ws.Name
                    cellAddress = cell.Address
                    cellValue = cell.Value
                    hyperlinkAddress = "'" & sheetName & "'!" & cellAddress

                    ' 新しいシートにデータを書き込む
                    newSheet.Cells(r, 1).Value = sheetName
                    newSheet.Cells(r, 2).Value = cellAddress
                    newSheet.Cells(r, 3).Value = cellValue
                    newSheet.Hyperlinks.Add _
                        Anchor:=newSheet.Cells(r, 4), _
                        Address:="", _
                        SubAddress:=hyperlinkAddress, _
                        TextToDisplay:="Go to Cell"

                    r = r + 1 ' 次の行へ
                End If
            Next cell
        End If
    Next ws

    ' 結果シートのフォーマットを整える
    With newSheet.Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    newSheet.Columns("A:D").AutoFit
End Sub

' シートが存在するかどうかを確認
Function SheetExists(sheetName As String) As Boolean
    Dim sht As Worksheet
    On Error Resume Next
    Set sht = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

' 一意のシート名を生成
Function GetUniqueName(baseName As String) As String
    Dim count As Integer
    count = 1
    Do While SheetExists(baseName & " " & count)
        count = count + 1
    Loop
    GetUniqueName = baseName & " " & count
End Function

マクロの実行手順

マクロを実行するには、まずExcelを開き、対象のワークブックを開きます。次に、Alt + F11 キーを押してVBAエディタを開き、新しい標準モジュールを挿入します(挿入→標準モジュール)。そして、提供したコードを貼り付けて、VBAエディタを閉じます。

マクロの実行にはAlt + F8キーを使ってください。

マクロ実行後の結果

マクロを実行すると、新しいシートがワークブックの最初に追加されます。このシートには、入力規則に違反するセルのシート名、アドレス、値がリストアップされます。各行の「ハイパーリンク」列をクリックすると、対象のセルに直接ジャンプできるようになっています。

使用時の注意点

マクロを実行する前に、ワークブックのバックアップを取ることをお勧めします。また、大規模なワークシートでは実行時間が長くなる可能性があるため、時間に余裕を持って実行してください。さらに、Excelのマクロ設定が「すべてのマクロを有効にする」または「マクロの有効化に警告する」に設定されている必要があります。

 

コメント