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
No.4ベストアンサー
- 回答日時:
継ぎ接ぎだらけになってしまいましたが、これでどうでしょう。
原理が理解出来たら、一度、整理することをお勧めします。
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の算出方法がキモですね。
自分は以下のような非効率的な方法しか思いつきませんでした。。
(しかもこの内容のプログラムもかけておりませんでした。。)
・検出文字列内の濁音と半濁音をカウントし、検索対象が半角カタカナだった場合にその差分を加える
・検索文字列の半角と全角の場合の差を出しておき、検索対象が半角カタカナだった場合にその差分を加える
効率的でシンプルな方法を教えていただき、感謝しております。
どうもありがとうございました。
No.3
- 回答日時:
「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文字としてカウントされ、
「パック」と「パッ」での比較になっていました。
検索文字列がカタカナだった場合の判定を加えてみたりしているのですが、まだうまくいっていません。。
No.2
- 回答日時:
こんな感じで、どうでしょう。
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・【お題】絵本のタイトル
- ・【大喜利】世界最古のコンビニについて知ってる事を教えてください【投稿~10/10(木)】
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
文字を打つときに文字に下線が...
-
フリーフォントで濁点
-
日本語入力On/Offを音などで知...
-
ATOK2005・ローマ字かな入力時...
-
IMEでローマ字入力で固定し、か...
-
ATOK2006で「うぉ」と入力した...
-
Illustrator8.0が勝手に閉じて...
-
「トゥ」をローマ字で打ちたい...
-
小さい「ウ」ってキーボードで...
-
X₁=3、X₂=4 の 小さい数字の...
-
「”」と対になる「チョンチョン...
-
プラス(足す)キーはどうやっ...
-
=を縦にした キーボードの入力...
-
shifキーを押しながらの半角英...
-
GTA5でチートを使いたいのです...
-
かぎ かっこ(「 」)のキーが...
-
ローマ字入力のキーボードで最...
-
濁音の「ヴェ」の打ち方
-
テンキーをものすごく早く打つ...
-
(word) 文字列の上に線を引く方法
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
カタカナを小文字から大文字に...
-
ハイパーリンクの中の半角カタ...
-
select case 大文字小文字を...
-
半角カタカナがVBAだと全角...
-
ァ→ア (アクセス)
-
google日本語入力
-
EXCEL 「ASC」関数 ...
-
文字を打つときに文字に下線が...
-
特定の文字列を検索し、HITした...
-
タスケテ
-
ローマ字打ちからひらがな打ち...
-
ピボットテーブルでワイルドカード
-
特打ヒーローズ名探偵コナン ...
-
筆ぐるめVer10で、かな入力が...
-
[半角/全角 漢字]キーを押さず...
-
IME言語バーの文字の種類をキー...
-
アメーバピグにて
-
Enterキー左横上のキーの小さい...
-
半角カタカナってどうやるの?
-
Xplane11で遊んでいますが頻繁...
おすすめ情報
条件の提示が不足があり申し訳ありません。
myStrの1文字目が、
アルファベットの場合:全/半角、大/小文字の区別なし
カタカナの場合:ひらがなとは区別、全/半角は区別なし
としたく、ママチャリさんにご提示いただいたプログラムの検索部分を以下のようにしてみました。
If StrConv(Left(myStr, 1), vbWide) Like "[A-z]" Or _
StrConv(Left(myStr, 1), vbWide) Like "[ア-ヴ]" Then
k = InStr(k, myRng, myStr, vbTextCompare)
Else
k = InStr(k, myRng, myStr, vbBinaryCompare)
End If
カタカナとひらがなの区別を加えられますでしょうか?