特定の文字列を検索し、HITしたら文字の色を変えたいが、半角カタカナが混じった場合にずれてしまう

VBAでオートシェイプ内の文字列を検索し、見つけた文字列の色を赤に変えたいと思っています。
（B2セルに文字列を入力し、マクロを実行するとテキストボックス内で該当の文字列を見つけて赤くする）
先日、ここで質問し、完成したと思ったのですが、検索対象の文字列に半角カタカナの濁音、半濁音があった場合に、色を付ける文字列がずれてしまうこに気づきました。

検索文字列がアルファベットの場合には全角、半角、大文字、小文字の区別をなくすため、
検索元の文字列を全角に変換したうえでInStr関数で検索しているため、半角カタカナの濁音、半濁音の文字数が一致しなくなってしまいました。
例）全角カタカナの「パ」…1文字 半角カタカナの「ﾊﾟ」…2文字

けっこう考えてみたのですが、いい方法が思いつきません。
アドバイスいただけますでしょうか。

現在のプログラム
Dim k As Long, myStr As String, myShp As Shape, myRng As Variant
myStr = StrConv(Range("B2"), vbWide + vbLowerCase)
For Each myShp In ActiveSheet.Shapes
Set myRng = myShp.TextFrame2.TextRange
If InStr(StrConv(myRng, vbWide + vbLowerCase), myStr) > 0 Then
For k = 1 To Len(myRng)
If Mid(StrConv(myRng, vbWide + vbLowerCase), k, Len(myStr)) = myStr Then
myRng.Characters(Start:=k, Length:=Len(myStr)) _
.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
Next k
End If
Next myShp

質問者からの補足コメント

• 

  条件の提示が不足があり申し訳ありません。
  myStrの1文字目が、
  アルファベットの場合：全/半角、大/小文字の区別なし
  カタカナの場合：ひらがなとは区別、全/半角は区別なし
  としたく、ママチャリさんにご提示いただいたプログラムの検索部分を以下のようにしてみました。
  
  If StrConv(Left(myStr, 1), vbWide) Like "[Ａ-ｚ]" Or _
  StrConv(Left(myStr, 1), vbWide) Like "[ア-ヴ]" Then
  k = InStr(k, myRng, myStr, vbTextCompare)
  Else
  k = InStr(k, myRng, myStr, vbBinaryCompare)
  End If
  
  カタカナとひらがなの区別を加えられますでしょうか？

    補足日時：2016/10/19 20:18

No.4 ベストアンサー 回答者： ママチャリ 回答日時： 2016/10/20 21:53

継ぎ接ぎだらけになってしまいましたが、これでどうでしょう。

原理が理解出来たら、一度、整理することをお勧めします。

Sub sample()
Dim k As Long, myStr As String, myShp As Shape, myRng As Variant
Dim L As Long
myStr = Range("B2")
For Each myShp In ActiveSheet.Shapes
Set myRng = myShp.TextFrame2.TextRange
k = 1
Do
k = InStr(k, myRng, myStr, vbTextCompare)
If k = 0 Then Exit Do
L = Len(Mid(myRng, k)) - Len(Replace(Mid(myRng, k), myStr, "", 1, 1, vbTextCompare))
If StrConv(Mid(myRng, k, L), vbWide + vbLowerCase) = _
StrConv(myStr, vbWide + vbLowerCase) Then
myRng.Characters(Start:=k, Length:=L) _
.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
k = k + L
Else
k = k + 1
End If
Loop
Next myShp
End Sub

この回答へのお礼

この内容で無事、目的が達成できました。
Lの算出方法がキモですね。
自分は以下のような非効率的な方法しか思いつきませんでした。。
（しかもこの内容のプログラムもかけておりませんでした。。）
・検出文字列内の濁音と半濁音をカウントし、検索対象が半角カタカナだった場合にその差分を加える
・検索文字列の半角と全角の場合の差を出しておき、検索対象が半角カタカナだった場合にその差分を加える

効率的でシンプルな方法を教えていただき、感謝しております。
どうもありがとうございました。

お礼日時：2016/10/24 17:37

No.3 回答者： ママチャリ 回答日時： 2016/10/19 21:27

「myStrの1文字目が、･･･」のルールがよくわからないのですが、要するに、半角／全角、大文字／小文字は区別せず、ひらがな／カタカナは区別したいということですよね？

であれば、こんな感じでいかがでしょう。
最終的に全角＆小文字にした状態で比較を行い、等しかったら色を付けます。この時、ひらがな／カタカナはそのままなので、異なっていれば色は付きません。
あまりテストをしていないので、漏れがあったら申し訳ないです。

Sub sample()
Dim k As Long, myStr As String, myShp As Shape, myRng As Variant
Dim L As Long
myStr = Range("B2")
L = Len(myStr)
For Each myShp In ActiveSheet.Shapes
Set myRng = myShp.TextFrame2.TextRange
k = 1
Do
k = InStr(k, myRng, myStr, vbTextCompare)
If k = 0 Then Exit Do
If StrConv(Mid(myRng, k, L), vbWide + vbLowerCase) = _
StrConv(myStr, vbWide + vbLowerCase) Then
myRng.Characters(Start:=k, Length:=L) _
.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
k = k + L
Else
k = k + 1
End If
Loop
Next myShp
End Sub

この回答へのお礼

テキストボックス内に全角の「パック」と半角の「ﾊﾟｯｸ」を入力し、
セルB2に「パック」と入力して試したところ、
テキストボックス内の半角の「ﾊﾟｯｸ」に変化がありませんでした。
vbWideになっているはずなのに何故？と思って調べたところ、
半角の場合は「ハ」で1文字、半濁点で1文字としてカウントされ、
「パック」と「パッ」での比較になっていました。

検索文字列がカタカナだった場合の判定を加えてみたりしているのですが、まだうまくいっていません。。

お礼日時：2016/10/20 16:53

No.2 回答者： ママチャリ 回答日時： 2016/10/17 21:04

こんな感じで、どうでしょう。

Sub sample()
Dim k As Long, myStr As String, myShp As Shape, myRng As Variant
myStr = Range("B2")
For Each myShp In ActiveSheet.Shapes
Set myRng = myShp.TextFrame2.TextRange
k = 1
Do
k = InStr(k, myRng, myStr, vbTextCompare)
If k = 0 Then Exit Do
myRng.Characters(Start:=k, Length:=Len(myStr)) _
.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
k = k + Len(myStr)
Loop
Next myShp
End Sub

No.1 回答者： くんこば 回答日時： 2016/10/17 19:19

http://officetanaka.net/excel/vba/function/Instr …
これは？