Excel vba 一度で全角・半角の文字を検索

質問

Excel vbaの初心者ですが、他のサイトを参考にして
以下のプログラムを作成しました。
指定された文字をシートから削除する物です。
「FindDelete」の中で、一度で全角・半角の文字を検索する方法があれば
教えてください。よろしくお願いします。
Sub FindDelete(ss As String)
Dim FoundCell As Range
Dim FirstCell As Range
Dim Target As Range
Dim c As Range
Dim findArea As Range

Set findArea = Intersect(Columns("E:F"), ActiveSheet.UsedRange)
Set FoundCell = findArea.Find(What:=ss, LookAt:=xlPart)
If FoundCell Is Nothing Then
MsgBox ss & "は見つかりません"
Exit Sub
Else
Set FirstCell = FoundCell
Set Target = FoundCell
End If
Do
Set FoundCell = findArea.FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
Set Target = Union(Target, FoundCell)
End If
Loop
Target.Select
If MsgBox(ss & "：" & vbCrLf & Target.Count & "件見つかりました", vbYesNo, "削除しますか？") = vbYes Then
For Each c In Target
c = Replace(c, ss, "")
Next c
End If

End Sub

Sub tFindDelete()
Dim ss As String

ss = "カブシキガイシャ"
ss = StrConv(ss, vbNarrow)
FindDelete (ss)
ss = StrConv(ss, vbWide)
FindDelete (ss)

ss = "ユウゲンガイシャ"
ss = StrConv(ss, vbNarrow)
FindDelete (ss)
ss = StrConv(ss, vbWide)
FindDelete (ss)
End Sub

回答No.3

end-u

質問文から察すると、「検索して件数を表示してTarget.Select」が必須のように受け取れますが、
そうではなくてFindDelete..「Delete」が目的の場合はRangeのReplaceメソッドを使えば良いようにも思えます。
Selectまではしませんが、件数を表示して消去するなら以下。参考まで。

Sub test()
　　Dim ss As String

　　ss = "カブシキガイシャ"
　　FindDelete2 ss
End Sub

Sub FindDelete2(ss As String)
　　Dim findArea As Range
　　Dim x　　　　As Long
　　Dim v

　　With ActiveSheet
　　　　Set findArea = Intersect(.Columns("E:F"), .UsedRange)
　　End With
　　If Not findArea Is Nothing Then
　　　　v = Application.Find(ss, findArea)
　　　　x = Application.Count(v)
　　　　v = Application.Find(StrConv(ss, vbNarrow), findArea)
　　　　x = x + Application.Count(v)
　　　　If x = 0 Then
　　　　　　MsgBox ss & "は見つかりません"
　　　　ElseIf MsgBox(ss & "：" & vbCrLf & x & "件見つかりました", vbYesNo, "削除しますか？") = vbYes Then
　　　　　　Cells.Find "" 'bug KB284881 対策
　　　　　　findArea.Replace What:=ss, Replacement:="", LookAt:=xlPart, MatchCase:=True, MatchByte:=False
　　　　End If
　　End If
End Sub

回答No.2

queuerev2

失礼いたしました。
findだけ直せばいいだろうと早合点して質問者様のコードを動かしていませんでした。

カタカナ対応ですが、

For Each c In Target
c = Replace(c, ss, "")
Next c

の３行のかわりに

Target.Value = ""

あるいは

Target.ClearContents

ではいかがでしょうか。
（Replaceを使わなくても単純に消すだけでいいと思いましたので）

回答No.1

queuerev2

Range.FindメソッドのMatchByte引数をFalseにしてみてはいかがでしょう。

Set FoundCell = findArea.Find(What:=ss, LookAt:=xlPart)
↓
Set FoundCell = findArea.Find(What:=ss, LookAt:=xlPart, MatchByte:=False)

補足

ありがとうございます。

やってみましたが、
アルファベットは、うまく行くようですが、
カタカナはうまく行かないのでしょうか？