お世話になります。
図面のタイトルの検索にてオートフィルターを使用してます。

一応R字とカナの半角・全角の検索はできました。

 Dim myName As String
     myName = Range("c3").Value
    If myName = "" Then
    Else
    With Sheets("リスト").Range("A1")
    .AutoFilter Field:=5, Criteria1:="*" & StrConv(myName, vbNarrow) & "*", Operator:=xlOr, Criteria2:="*" & StrConv(myName, vbWide) & "*"

上記だとひががな・カナの検索ができないので

Dim myName1, myName2
    myName1 = Range("c3").Value
    myName2 = Range("c3").Value
    If myName1 = "" Then
    Else
    If myName2 = "" Then
    Else
    
    With Sheets("リスト").Range("A1")
    .AutoFilter Field:=5, Criteria1:="*" & StrConv(StrConv(myName1, vbWide), vbHiragana) & "*", Operator:=xlOr, Criteria2:="*" & StrConv(StrConv(myName2, vbWide), vbHiragana) & "*"
上記だと　反対にR字・カナに対応しません。
全部に対応するコードはありますでしょうか？

Ｅ列の文字列を全角・ひらがなに変換した作業列を作り、それを検索対象とするか

または全角・ひらがなに変換するユーザー定義関数を作成し、数式を使用したフィルター詳細を利用することが考えられます
検索する文字列がWorksheets("Sheet2")のC3セルにある場合の例です。

Sub Macro1()
    Const 検索条件シート = "Sheet2"
    Const 検索条件セル = "C$3"
    Dim cr As Range
    
    Set cr = Worksheets(検索条件シート).UsedRange
    Set cr = cr.Offset(, cr.Columns.Count).Resize(2, 1)
'    cr(1).Value = "検索条件"
    cr(2).Formula2 = "=IFERROR(SEARCH(WideHiragana(" & _
            検索条件セル & "),WideHiragana(リスト!E2)),FALSE)"
    Worksheets("リスト").Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, cr
    cr.ClearContents
End Sub

Function WideHiragana(s As String) As String
    WideHiragana = StrConv(s, vbHiragana + vbWide)
End Function

kazuo様
お忙しいなかコードを書いていただきありがとうございます。


    cr(2).Formula2 = "=IFERROR(SEARCH(WideHiragana(" & _
            検索条件セル & "),WideHiragana(リスト!E2)),FALSE)"
 上記で「アプリケーション定義またはオブジェクト定義のエラーです。」
とでました。
Functionでちょっと調べてもおぼつかなく、またそれだけの技量もなく
わかりませんでした。申し訳ありません。




もう少し自分で調べて
Sub これで検索w()

'以前の検索を削除
    Sheets("検索シート").Activate
    Rows("10:65536").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete
 
    Dim myName As String
   
    myName = Range("c3").Value
    If myName = "" Then
    Else
    
    With Sheets("リスト").Range("A1")
    .AutoFilter 5, Array("*" & StrConv(myName, vbNarrow) & "*", "*" & StrConv(myName, vbWide) & "*", "*" & StrConv(myName, vbHiragana) & "*"), xlFilterValues
                   
    .CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("検索シート").Range("A9")
    .AutoFilter
    '検索シートの10〜200列まで高さを【20】にした
    Worksheets("検索シート").Range("10:200").RowHeight = 20
    End With
    End If
    End Sub

こちらだと　カタカナは半角で入力すればひらがなとかたかなが混じった「ふれあいｾﾝﾀｰ」で検索すれば出ますが
できたら「ふれあいセンター」で検索出来るといいのですが。また「フレアイセンター」でも検索できるとなおいいのですが
【vbHiragana】を足して4個の検索しましたがこちらは上手くいきませんでした。
なにぶん建物名の検索なので元の文字を直すの事はありません。
よろしくお願いします。

>Rows("10:65536").Select
ということは、Excel2003以前ですか？
今後質問するときはOS選択、Excelのバージョン選択を必ずしてください。

環境ないので試せませんが、
>    cr(2).Formula2 = "=IFERROR(SEARCH(WideHiragana(" & _
>            検索条件セル & "),WideHiragana(リスト!E2)),FALSE)"
Range.Formula2プロパティの動作に不安がありますし、ワークシート関数IFERRORも使えそうもありませんので、

>なにぶん建物名の検索なので元の文字を直すの事はありません。
作業列方式を採用ください。
一例
なお、複数の検索値を使用する場合は、リストが変更になるまでは作業列を一々消さずに検索するよう考慮してみてください。

Sub Macro作業列方式()
    Dim myName As String
    Dim myData
    Dim myRange As Range
    Dim 作業列 As Range
    Dim i As Long
    
    '以前の検索をクリア
    With Worksheets("検索シート")
        .Activate
        .Rows("10:" & .Rows.Count).Delete
        myName = .Range("c3").Value
    End With
   
    If myName <> "" Then
        With Worksheets("リスト").Range("A1")
            If .Worksheet.FilterMode Then .AutoFilter   'フィルター解除
            Set myRange = .CurrentRegion
            myData = myRange.Resize(myRange.Rows.Count + 1).Columns(5)  '2行以上を担保
            Set 作業列 = myRange.Offset(, myRange.Columns.Count).Resize(, 1)
        End With
        For i = 2 To UBound(myData)
            myData(i, 1) = StrConv(myData(i, 1), vbWide + vbHiragana)   '全角・ひらがなに変換
        Next
        With 作業列
            .Value = myData
            .AutoFilter 1, "*" & StrConv(myName, vbWide + vbHiragana) & "*" '全角・ひらがなでフィルター
            myRange.Copy Worksheets("検索シート").Range("A9")
            .AutoFilter
            .ClearContents
        End With
    '検索シートの10〜200列まで高さを【20】にした
        Worksheets("検索シート").Range("10:200").RowHeight = 20
    End If
End Sub