名前定義と入力規則のリンク切れと外部参照を確認（リンクの解除ができない時）

Sub 名前定義と入力規則のリンク切れと外部参照確認()
    
    Dim sh As Worksheet
    Dim nm As Name
    Dim strNameMsg As Variant
    Dim rng As Range
    Dim strVlistMsg As Variant
    
    '名前定義
    For Each sh In Sheets
        For Each nm In sh.Names
            If InStr(nm.RefersTo, "#REF") > 0 Or InStr(nm.RefersTo, ".xl") > 0 Then
                strNameMsg = strNameMsg & vbCrLf & sh.Name & " : " & nm.Name & " : " & nm.RefersTo
            End If
        Next nm
    Next sh
    
    '入力規則
    For Each sh In Sheets
        '入力規則が設定されているか確認
        On Error Resume Next
        Set rng = sh.Cells.SpecialCells(xlCellTypeAllValidation)
        On Error GoTo 0
        If rng Is Nothing Then
            '設定されていなければ何もしない
        Else
            '設定されている
            For Each rng In sh.Cells.SpecialCells(xlCellTypeAllValidation)
                If rng.Validation.Type = xlValidateList Then
                    If InStr(rng.Validation.Formula1, "#REF") > 0 Or InStr(rng.Validation.Formula1, ".xl") > 0 Then
                        strVlistMsg = strVlistMsg & vbCrLf & sh.Name & " : " & rng.Address(False, False) & rng.Validation.Formula1
                    End If
                End If
            Next rng
        End If
    Next sh

    '結果をメッセージで表示
    MsgBox "[名前定義] " & strNameMsg & vbCrLf & vbCrLf & _
           "[入力規則] " & strVlistMsg, _
            vbOKOnly + vbInformation

End Sub