[[20191022000923]]　『入力規則の検索をブック全体で行いたい。』（かぐるお）　ページの最後に飛ぶ

『入力規則の検索をブック全体で行いたい。』（かぐるお）

入力規則のコメントの文字列で検索をかけることは可能でしょうか？
同一シート内であればジャンプで選択できるようですが、
複数シートで検索がしたいです。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

入力規則の「コメント」とは何のことでしょうか。
説明をお願いします。

（γ） 2019/10/22(火) 08:41

↓もわかりません。どのような操作でしょうか。

＞同一シート内であればジャンプで選択できるようですが、

（マナ） 2019/10/22(火) 08:50

＞入力規則の「コメント」とは何のことでしょうか。
説明をお願いします。

「データの入力規則」の「入力時メッセージ」タブの「タイトル」や「入力時メッセージ」のことを指していました。説明をはしょってしまい申し訳ありません。

↓もわかりません。どのような操作でしょうか。
＞同一シート内であればジャンプで選択できるようですが、
１．検索した入力規則が設定されているセルを選択する。
２．ACtrl＋Gでジャンプダイアログを表示する。
３．Bセルの選択ボタンを押す。
４．選択オプションで「データの入力規則」の「同じ入力規則」を選択する。
５．シート内で１．で選択した入力規則と同じ入力規則が設定されているセルが選択される。

複数シートで検索できる方法を探しています。
（かぐるお） 2019/10/22(火) 10:59

＞「入力時メッセージ」タブ

その他の設定が異なっている場合は？

（マナ） 2019/10/22(火) 11:40

 こんなことでしょうか

 ある入力規則の設定されているセルを選択して、コードを実行すると
 まず入力規則の設定されているセルの中から
 それぞれのテキスト（タイトルやら、メッセージやら）が同じものを選択します、
 それを全シートを対象として行っています。

 Sub Macro1()
    Dim myRng As Range
    Dim mySameRng As Range
    Dim myCell As Range
    Dim mySht As Worksheet
    Dim myVld As Validation
    Dim myTmp As Long

    Set myVld = ActiveCell.Validation
    On Error Resume Next
        myTmp = myVld.AlertStyle
    On Error GoTo 0
    If myTmp = 0 Then
        MsgBox "選択セルには入力規則が設定されていません"
        Exit Sub
    End If

    For Each mySht In ThisWorkbook.Worksheets
        mySht.Activate
        mySht.Range("A1").Activate
        Set myRng = Nothing
        Set mySameRng = Nothing
        On Error Resume Next
            Set myRng = Selection.SpecialCells(xlCellTypeAllValidation)
        On Error GoTo 0
        If Not myRng Is Nothing Then
            For Each myCell In myRng.Cells
                With myCell.Validation
                    If .InputTitle = myVld.InputTitle And _
                        .ErrorTitle = myVld.ErrorTitle And _
                        .InputMessage = myVld.InputMessage And _
                        .ErrorMessage = myVld.ErrorMessage Then
                            If mySameRng Is Nothing Then
                               Set mySameRng = myCell
                            Else
                               Set mySameRng = Union(mySameRng, myCell)
                            End If
                    End If
                End With
            Next
        End If
        If Not mySameRng Is Nothing Then mySameRng.Select
    Next
    myVld.Parent.Parent.Activate
 End Sub

（渡辺ひかる） 2019/10/22(火) 12:04

 ちょっと検証不足気味ですが、、

 仕掛けは、、
 1.入力規則のあるセルを選択してダブルクリックすると
 2.各SheetのA1にその入力規則をコピーして貼り付けます。(ダミーです。内容によっては同じにならないかもしれませんね？）
 3.今回はエラータイトルの中の検索文字をInputBoxで入力します。
 4.各Sheetをループして同じ入力規則の中からその文字が含まれているものに色を付けます。
　(同じ入力規則・・・？あまり意味がないかも？？(^^;）
　この辺を応用して頂けると助かります。

 ThisWorkbookモジュールに貼り付けます。

 まぁ、、何かの参考になれば幸いです。。。。

 Option Explicit
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim r As Range
Dim x As Variant
Dim MyStr As Variant
Dim ws As String
Dim n As Long
Cancel = True
On Error Resume Next
    x = Target.Validation.Type
    If Err.Number <> 0 Then
        MsgBox "入力規則がありません"
        Exit Sub
    End If
On Error GoTo 0
MyStr = Application.InputBox("検索する文字を入力してください。。", Type:=2)
If MyStr = False Then Exit Sub
Application.ScreenUpdating = False
    ws = Sh.Name
    Target.Copy
    For Each Sh In ThisWorkbook.Worksheets
        Sh.Activate
        Sh.Range("A1").PasteSpecial Paste:=xlPasteValidation
        ActiveCell.SpecialCells(xlCellTypeAllValidation).Interior.Pattern = xlNone
    Next
    For Each Sh In ThisWorkbook.Worksheets
        Sh.Activate
        For Each r In ActiveCell.SpecialCells(xlCellTypeSameValidation)
            If InStr(1, MyStr, r.Validation.ErrorTitle) > 0 Then
                r.Interior.Color = 65535
                n = n + 1
            End If
        Next
    Next
    For Each Sh In ThisWorkbook.Worksheets
        n = n - 1
        Sh.Range("A1").Clear
    Next
    Sheets(ws).Activate
    Target.Activate
Application.ScreenUpdating = True
If n > 0 Then
    MsgBox n & "　個ヒットしました。"
Else
    MsgBox MyStr & "　を含む入力規則はありません。"
End If
End Sub
（SoulMan） 2019/10/22(火) 17:12

コメント返信：

[ 一覧(最新更新順) ]

[[20191022000923]] 『入力規則の検索をブック全体で行いたい。』（かぐるお） ページの最後に飛ぶ

[[20191022000923]]　『入力規則の検索をブック全体で行いたい。』（かぐるお）　ページの最後に飛ぶ