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で質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルシート中の全角英数字を半角に変換したい 4 2022/07/07 13:14
- Access(アクセス) Accessのテキストボックスの入力文字制限 1 2023/01/18 20:43
- その他(Microsoft Office) WordやExcelで英数字のみ半角または全角にしたい 6 2022/08/03 08:18
- その他(データベース) Accessのクエリで1フィールドの抽出条件設定をNullでなく全角半角含む空白のみの文字列でない文 1 2023/04/24 15:20
- Visual Basic(VBA) VBA初心者です 検索した数字の行に色をつける 5 2023/02/13 14:22
- Excel(エクセル) capeofdragonと申します Excel2016を使っておりまして 半角又は全角の任意文字列が 2 2022/10/31 13:51
- Visual Basic(VBA) 特定の文字を簡単な操作で半角スペースに変換するか削除したい 2 2022/11/01 10:35
- Excel(エクセル) 指定文字列が該当するA列をアクティブセルにするには 3 2022/08/17 13:18
- Visual Basic(VBA) VBA 「,」・空白・カタカナ等の複数条件のマクロ 2 2023/08/23 11:57
- Excel(エクセル) 【マクロ】フォルダAからダBへファイルを、ファイルの更新日時の条件で、1つづつ移動するには? 3 2022/08/25 09:56
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
カタカナを小文字から大文字に...
-
ハイパーリンクの中の半角カタ...
-
ローマ字入力ができない
-
select case 大文字小文字を...
-
ソースネクストアプリをインス...
-
ローマ字打ちからひらがな打ち...
-
ひらがなになっちゃう・・・・・・
-
ァ→ア (アクセス)
-
カタカナでフジショウコウギョ...
-
gooメールのNTTアンケートの小...
-
「トゥ」をローマ字で打ちたい...
-
小さい「ウ」ってキーボードで...
-
「”」と対になる「チョンチョン...
-
プラス(足す)キーはどうやっ...
-
どうでもいいような質問ですい...
-
ローマ字入力のキーボードで最...
-
キーボードがCtrlキーが押され...
-
X₁=3、X₂=4 の 小さい数字の...
-
=を縦にした キーボードの入力...
-
Scroll Lockが勝手に有効になる...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
カタカナを小文字から大文字に...
-
ハイパーリンクの中の半角カタ...
-
半角カタカナがVBAだと全角...
-
ァ→ア (アクセス)
-
文字を打つときに文字に下線が...
-
日本語入力On/Offを音などで知...
-
select case 大文字小文字を...
-
半角英数字を大文字に変換する...
-
[半角/全角 漢字]キーを押さず...
-
エクセルでひらがな全角~カナ...
-
ローマ字打ちからひらがな打ち...
-
パソコン入力時に、ローマ字固...
-
EXCEL 「ASC」関数 ...
-
ピボットテーブルでワイルドカード
-
ATOKの入力がおかしくなること...
-
\(^o^)/ パソコンのプロが使...
-
PCオフィス2010の漢字変換について
-
ATOKの変換がおかしくなった時...
-
全角ローマ字打ちでのタイピン...
-
hp windows 10 英語から日本語...
おすすめ情報
条件の提示が不足があり申し訳ありません。
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
カタカナとひらがなの区別を加えられますでしょうか?