エクセル検索について

質問

以前教えていただいた方法で検索窓を作成しました。
質問No.9377089
シートにテキストボックス１個、コマンドボタン２個を配置し、下記を記載しました。
Option Explicit

Private Sub CommandButton1_Click()
Dim Target As Range, rCrit As Range, sCrit As String
Dim nR As Long, cnC As Long, i As Long
　　Application.ScreenUpdating = False
　　On Error Resume Next
　　ActiveSheet.ShowAllData
　　On Error GoTo 0
　　sCrit = "=""*" & TextBox1.Value & "*"""
　　Set Target = Cells.CurrentRegion
　　nR = Target.Rows.Count + 2
　　cnC = Target.Columns.Count
　　Set rCrit = Cells(nR, 1).Resize(cnC + 1, cnC)
　　For i = 1 To cnC
　　　　rCrit(i) = Cells(i)
　　　　rCrit(i + 1, i) = sCrit
　　Next i
　　Target.AdvancedFilter _
　　　　Action:=xlFilterInPlace, _
　　　　CriteriaRange:=rCrit, _
　　　　Unique:=False
　　rCrit.ClearContents
　　Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click()
　　On Error Resume Next
　　ActiveSheet.ShowAllData
　　On Error GoTo 0
End Sub

希望としてはシート内の文字はすべて検索対照にしたい。
検索後にテキストが消えないようにしたいです。

どうぞよろしくお願い致します。

回答No.1

real beatin（@realbeatin）

なんか、言葉少なに無茶振りっぽいですけどね。
> 希望としてはシート内の文字はすべて検索対照にしたい。
やりたいことは、普通の"検索"とは違いますし、
> フィルターの扱いですから、検索ではなくて抽出ですね。
と私が書いたことにも反応ないので、惑わされます。
あなたの言う"検索"は、一般的な意味とは違うのですから、
その独自なニーズを十分に言葉で表現するようにしないと、
ただの後出しになってしまっていますね。

　A　　　　B　　　　C　　　　
－－－－－－－－－－－－－－
1　　　　 血液型　　　　　
2　　　　　 A
3 　　　　　B
4 　　　　　O
5 　　　　　AB

No.4072490で例示されているように、
　空行を挟まない、１行めに見出し行がある、という
[フィルター]機能を使う為の要件
を満たしていないシートレイアウトで使いたい、
ということなら、最初にそう言ってくれないと、、、。
> 検索範囲がB列に限定されてしまいます。
> シート状のすべてで検索することはできるでしょうか。
[フィルター]機能を使う為の要件を満たした上で、
全ての列をOR検索で抽出した結果を得られるように書いたのが、
先回のマクロです。
[フィルター]機能を使う為の要件を満たしていれば機能します。
>　　シート左上からの連続領域全体（タイトル行除く）で、
>　　テキストボックスに入力されいている値に合致するセルが、
>　　　見つかれば、その行を表示
>　　　ひとつも見つからなければ、その行は非表示
> といった内容のマクロを書きました。
これ↑読んでますか？
使用条件が変われば、機能しなくなるのも当然ですし、
変更に合わせてユーザーが自身の手で手当てをするのが、
こういった無償の掲示板で得られるマクロというものです。
色々思い違いをなさっているように思うのですが、、、。
今回初めて提示された添付画像のシートレイアウトで、
先回ご提示の質問No.4072490の回答者様のマクロは、
> 一回目の検索とフィルタ戻しは問題なくできましたが、
本当に"問題なくでき"たのですか？
話が都合よく変わって行ってるような気がするのですけれど。

さておき、取り急ぎ、今までに散見される情報から
類推されるニーズに応えるようなマクロをあらためて書きました。
今回は、フィルターもフィルターオプションも使わず、
セルに値を書いたり消したりといった簡易仕様ではありません。
[フィルター]機能を使う為の要件を満たしていなくても、
機能するようにしました。
但し、常に表示しておく見出し行の行数については、
そちらで適宜（Const Midashi_Gyousuu = 2 を）
書き換えてから使ってください。
添付画像に
> Ｃ、Ｄ，Ｅ列から検索しようとすると ...
> ... 検索範囲をＢ，Ｃ，Ｄ列にしてみます。
といった文言をみつけましたが、
範囲を任意に限定できる
ような機能に関する説明も要求もなかったですし、
質問No.4072490のマクロにもそんな機能はなかったですし、
質問No.9377503で提示したのマクロにも何処にも書いていません。
元々は、
> シート状のすべてで検索する
という説明のみだったので、やや不思議なお話なのですが、
列を限定しての抽出を可能にして欲しい、という追加オーダー、
なのでしょう、、、ということで、
ボタンを押した時、セル範囲を列単位で選択していた場合は、
選択中の列でのみマッチングを行い、
それ以外の場合は全ての列でマッチングを行うように書きました。
５０通り程度、レイアウト等の条件を替えて、
意地悪テストもしてみましたが、思いつく限りでは、
機能しています。といっても、仕事で受けたなら納品まで１ヶ月
は貰う内容を数時間で書いてテストしているだけですから、
やり尽くした訳でもなく、当然、漏れはあります。
再度、思い通りの結果が得られなかった場合の手当てをこちらに求めたり、
あなたが思っているだけで伝えていないあなたの要求仕様
について、次々小出しにするのはお門違い、ということだけは
ご理解くださいね。その上で、ご自身のやりたい事を整理して、
一度ですべてを伝えられる、こちらに理解できる内容の
補足があれば、もう一度ぐらいは、お応えするつもりはあります。
（恐らく、今の時点でもこちらの理解も到っていないのでしょうから）
ただ、あなたの眼に触れた現象を画像の中の潰れた文字でレポート
するだけでは何も伝わりませんし、むしろ対話を阻害します。
あなたの求めることを正しく文字にして伝えて下さいませ。

では、今回あらためたマクロです。
' // ActiveXコントロールのCommandButton1-2、TextBox1を配置済であること必須
Private Sub CommandButton1_Click()
Const Midashi_Gyousuu = 2
Dim oDtO As New MSForms.DataObject
Dim rUsed As Range, rSel As Range, rTarget As Range, a As Range
Dim sCrit As String, sBuf As String, aryS() As String, sRef As String
Dim t As Long, b As Long, i As Long, cn As Long, aryF() As Boolean
　　CommandButton2_Click
　　sCrit = TextBox1.Value
　　Set rUsed = UsedRange
　　If Midashi_Gyousuu > 0 Then Set rUsed = rUsed.Offset(Midashi_Gyousuu) _
　　　　　　　　　　　　　　　　　　.Resize(rUsed.Rows.Count - Midashi_Gyousuu)
　　Set rSel = ActiveWindow.RangeSelection
　　If rSel.Rows.Count = Rows.Count Then
　　　　Set rTarget = Intersect(rUsed, rSel.EntireColumn)
　　Else
　　　　Set rTarget = rUsed
　　End If
　　t = rTarget.Row
　　b = t - 1 + rTarget.Rows.Count
　　Application.ScreenUpdating = False
　　ReDim aryF(t To b + 1)
　　For Each a In rTarget.Areas
　　　　a.Copy
　　　　oDtO.GetFromClipboard
　　　　sBuf = oDtO.GetText
　　　　oDtO.Clear
　　　　aryS = Split(sBuf, vbCrLf)
　　　　For i = t To b
　　　　　　If InStr(1, aryS(i - t), sCrit, vbTextCompare) Then
　　　　　　　　aryF(i) = True
　　　　　　　　cn = cn + 1
　　　　　　End If
　　　　Next i
　　Next
　　Application.CutCopyMode = 0
　　Application.StatusBar = StrConv(Space$(3) & b - t + 1 & _
　　　　　　　　　　" レコード(行)中 " & cn & " 件(行)見つかりました", vbWide)
　　aryF(b + 1) = Not aryF(b)
　　For i = t To b
　　　　If aryF(i) Xor aryF(i + 1) Then
　　　　　　If aryF(i) + 1 Then
　　　　　　　　sRef = sRef & "," & t & ":" & i
　　　　　　Else
　　　　　　　　t = i + 1
　　　　　　End If
　　　　End If
　　Next i
　　If sRef = "" Then Exit Sub
　　If Len(sRef) > 256 Then
　　　　i = 1
　　　　Do
　　　　　　i = InStrRev(sRef, ",", i + 257)
　　　　　　If i Then Mid(sRef, i) = vbLf
　　　　Loop While i
　　　　aryS = Split(Mid$(sRef, 2), vbLf)
　　　　For i = UBound(aryS) To 0 Step -1
　　　　　　Range(aryS(i)).EntireRow.Hidden = True
　　　　Next i
　　Else
　　　　Range(Mid$(sRef, 2)).EntireRow.Hidden = True
　　End If
　　Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click()
　　On Error Resume Next
　　ShowAllData
　　On Error GoTo 0
　　Rows.Hidden = False
　　Application.StatusBar = ""
End Sub
' /