InStrRev関数とLeft関数とRight関数の組み合わせについて教えてください。

質問

ワード２００２で作成した技術文書について、
（１）（和文字＋英数字）の文字列を任意に指定して、
（２）最初に文字数ｘを求め、
（３）次にInStrRev関数で英数字の1つ前の和文字について、文字列の初めからの数ｎを求める、
（４）Left関数で和文字を取り出す、（Msgboxに和文字を表示）
（５）Right関数で英数字を取り出す、（Msgboxに英数字を表示）
というマクロを作りたいのですが、
下記のマクロで足りないところを教えてください。
宜しくお願いします。
Private Sub YougoFugouBetunuki ()
Dim myText As String
Dim x As Integer
Dim Yougo As String
Dim Fugou As String

myText = Selection.Range.Text
x = Selection.Characters.Count
Fugou = "０-９Ａ-Ｚａ-ｚ’"
n = InStrRev(myText, Fugou)
Yougo = Left(myText, n)
Fugou = Right(myText, x-n)
End Sub

回答No.1

himajin100000 · ベストアンサー

Option Explicit

'多分やりたいのは文字列探しじゃなく正規表現
'参照設定でMicrosoft VBScript Regular Expressions 5.5を追加しています

Sub Sample1()
Dim RE As RegExp, strPattern As String, rt As String, Matches As Object
Dim index As Long ' Left関数とかRight関数とかFirstIndexプロパティの戻り値の型がわからん。
Dim Yougo As String
Dim Fugo As String
rt = Selection.Range.Text
Set RE = New RegExp
strPattern = "[0-9A-za-z]+"
With RE
.Pattern = strPattern ''検索パターンを設定
.IgnoreCase = True ''大文字と小文字を区別しない
.Global = True
End With

Set Matches = RE.Execute(rt)

index = Matches.Item(Matches.Count - 1).FirstIndex
Yougo = Left(rt, index)
Fugo = Right(rt, Len(rt) - index)
MsgBox (Yougo)
MsgBox (Fugo)
Set Matches = Nothing
Set RE = Nothing

End Sub

お礼

>Yougo = Left(rt, index)
>Fugo = Right(rt, Len(rt) - index)
>は和文字と英数字を選択文字列から取り出していないようです。
と書きましたが、
.Text = "Yougo"
.Replacement.Text = "Yougo"
を
.Text = Left(rt, index)
.Replacement.Text = Right(rt, Len(rt) - index)
に直したら使えました。
ありがとうございました。

補足

Microsoft VBScript Regular Expressions 5.5を参照設定して実行してみました。
MsgBox (Yougo)
MsgBox (Fugo)
の表示がばっちりでした。
実は、YougoとFugoは、このあとに、
色塗りに使います。

例えば、
Options.DefaultHighlightColorIndex = wdTurquoise
Selection.Range.HighlightColorIndex = wdTurquoise
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "Yougo"
.Replacement.Text = "Yougo"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
とコードを続けると、水色の蛍光になる部分は、
rtについて行われ、しかも文章中の選択文字列のみでした。

他の、同一の文字列について、
Selection.Find.Execute Replace:=wdReplaceAll
が効きませんでした。
これから考えると、
Yougo = Left(rt, index)
Fugo = Right(rt, Len(rt) - index)
は和文字と英数字を選択文字列から取り出していないようです。

回答No.3

Wendy02

こんにちは。

いままでの質問は、
（和文字＋英数字）
「あいう１２３ａ」

#2の補足欄で、
和文字＋数個の全数字+和文字１個+(和文字＋全英数字＋0個か１個の全角または半角不明の'アポストロフィ）
「第１のセンサ２３ａ」
とか、
「第１のあんアん亜龠１２３ａ」

という条件で、うまく行かなかったといわれても当然だと思いますし、次に、#1 の補足欄で、色塗りということですか。

質問は似ていても、それでは最初から、やり直しになってしまいます。

そのように連続的に、後出しの条件はダメです。切り分ける内容も最初から正しく公開されていませんから、質問する前によくまとめて、詳しい情報を最初から、分かりやすく書いてください。

特に、色づけするにしても切り分けるにしても、データがどうなっているのか、なるべく元の原稿に近いものを見せないとダメです。曖昧な質問は、曖昧な解答しか出てきません。

全角、半角の問題とか、特に、Word VBAには、行という概念そのものがありません。見えているものにしか、行が存在しません。VBAでの概念は、Paragraph です。だから、見えているものを行と考えてマクロを作ると失敗することがあります。Selection.Text では、単なるベタのテキストというだけで、正規表現で切り分けても、Document から切り離されているので、そのままでは後が続きません。

特に、Wordの色塗りは別問題です。最初から、色を塗るなら塗るというコードにしないとだめです。MsgBox で出したら、その後で別のコードが必要になりますし、ややこしいです。

回答者に、かなりの経験があれば別ですが、Wordマクロは特殊なものですから、あまりうまく行かない場合は、Excelで処理したほうがよいです。Excel VBAユーザーは圧倒的に多いのです。

それと、見ているうちに、補足欄で分かったのは、それは、前回の質問ですよね。(QNo.4112579　ワードの文字列操作のコード(日本文字と英数字を格別に取り出すコード)　＋　QNo.4138489 うしろ側の英数字のみ赤くするにはどうしたら？ )

今度は、「水色の蛍光になる部分」ですか？前回は、赤の太字ではなかったでしょうか。前回の質問(QNo.4112579, Q.No.4138489)は、レスが付いていないようですから削除して、それと、なるべく質問は一環してください。見ている人は見ています。連続の質問の後だしはダメです。

最近、私はあまり掲示板に書けませんが、あまりレスが付きにくいようでしたら、小出しに質問を出すようなことをせずに、一旦、ここの掲示を締めたり、削除して、他の掲示板で聞いてみるか、英語のWord　VBA　の掲示板を探してみるかしてみてください。

なお、IsNumeric を使っていたので、全角・半角の区別はありませんが、正規表現では、かなり違いますから、明確にしてください。Like 演算子には、Compare Text モードがありますが、正規表現では別扱いです。
技術文などでは、英数字は半角に決まっているはずです。今までの流れから、「英数字全角」として扱うことにしました。また、行という概念は考慮していませんので、文字列パターンが同じなら、文中でも、該当するようにしています。

[０-９]+[Ａ-ｚ]+ 半角・全角なら、
[０-９0-9]+[Ａ-ｚA-z]+
となります。

'ThisDocument か、標準モジュールに貼り付け
'Option Explicit
'ここで色を調整
Private Const MYCOLOR As Long = wdColorLightBlue '色-水色

Sub StrFindProc()
'必要なら、参照設定 Microsoft VBScript Regular Expressions(なくてもよい）
Dim objRegExp As Object ''参照設定の場合　objRegExp AsNew RegExp
Dim mySelection As Selection
Dim Matches As Object
Dim Match
Dim strData()
Dim sLength As Long
Dim i As Long
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Set mySelection = Selection
　　Set objRegExp = CreateObject("VBScript.RegExp")　'参照設定したら要らない
　　With objRegExp
　　　　.Global = True
　　　　.IgnoreCase = True
　　　　.Multiline = True
　　　　.Pattern = "[\u3041-\u30FE\u4E00-\u9FA5\uff5B-\uff9f]+[０-９]+[Ａ-ｚ]+['’]?"
　　　　Set Matches = .Execute(mySelection.Text)
　　End With
　　If Matches.Count = 0 Then MsgBox _
　　"該当する検索文字が見つかりません", 64: Exit Sub
　　For Each Match In Matches
　　　　　　 ReDim Preserve strData(i)
　　　　　　 strData(i) = Match.Value
　　　　　　 i = i + 1
　　Next Match
　　Application.ScreenUpdating = False
　　For i = 0 To UBound(strData)
　　　WordColorPrc strData(i)
　　Next
　　Application.ScreenUpdating = True
　　Selection.HomeKey Unit:=wdStory
End Sub

Sub WordColorPrc(ByVal myStr As String)
　　Dim i As Long, e As Long, t As Long
　　Selection.Find.ClearFormatting
　　Selection.Find.Replacement.ClearFormatting
　　Selection.Find.Replacement.Highlight = True
　　With Selection.Find
　　　　.Text = myStr
　　　　.Replacement.Text = myStr
　　　　'.Replacement.Font.Color = MYCOLOR
　　　　.Forward = True
　　　　.Wrap = wdFindContinue
　　　　.Format = True
　　　　.MatchCase = False
　　　　.MatchWholeWord = False
　　　　.MatchByte = False
　　　　.MatchAllWordForms = False
　　　　.MatchSoundsLike = False
　　　　.MatchWildcards = False
　　　　.MatchFuzzy = False
　　End With
　　Selection.Find.Execute
　　e = Len(Selection.Text)
　　For i = e To 1 Step -1
　　　　If Mid(Selection.Text, i, 1) Like "[ぁ-龠]" Then
　　　　　　t = i
　　　　　　Exit For
　　　　End If
　　Next i
　　Selection.Collapse Direction:=wdCollapseEnd
　　Selection.MoveLeft Unit:=wdCharacter, Count:=e - t
　　Selection.MoveRight Unit:=wdCharacter, Count:=e - t, Extend:=wdExtend
　　Selection.Font.Color = MYCOLOR
　　'Selection.Font.Bold = True　'太字
　　Selection.Collapse Direction:=wdCollapseEnd
　　t = 0
End Sub

お礼

ありがとうございました。ANo.2の回答のコードについて、
strPattern = "[０-９Ａ-Ｚａ-ｚ'0-9A-za-z'－]+"、と変更を加え、後は、マクロ記録したコードを繋ぎましたところ、上手く実行できました。実際の技術文書に適用して、色をつけたり消したりして、満足なマクロに仕上がりました。

QNo.4138489 うしろ側の英数字のみ赤くするにはどうしたら？については、エクセルでした。このコードが、今度の質問のケース（ワード）でも使えると思って、この前の１週間、検討していたのですが、私の力では無理でした。それで、今度の質問を出しました。前の質問は、エクセルの一覧表にした文字列の処理に使っています。ですから、今度は、「水色の蛍光になる部分」で、前回は、赤の太字というのは、整合性が取れていなくても、全く違うところで使いますから、良いわけです。

QNo.4112579　ワードの文字列操作のコード(日本文字と英数字を格別に取り出すコード　　については、今回の質問設定と同じです。今度の質問では、文字列関数の組み合わせを調べたので質問しました。前回の質問でレスが付かないので削除してくださいと言う通知が来まして、削除しようとしましたが、良く分からなかったことと、４週間経つと自動的に削除と言うことが書いてあったので、そのままにしてあります。
　なお、技術文などでは、英数字は半角に決まっているはずです。・・・ということですが、特許の技術文書は、英数字も半角厳禁です。全部べたうちです。
　.Pattern = "[\u3041-\u30FE\u4E00-\u9FA5\uff5B-\uff9f]+・・・?"
のところは分かりませんが、調べて理解します。

コードが2つのマクロになっていますが、折角示していただきましたので、ＶＢＥにコピーして実行してみましたが、できませんでした。

ありがとうございました。

回答No.2

imogasi

Fugou = "０-９Ａ-Ｚａ-ｚ’"
は
正規表現の表現でしょう。それではVBSなど使わないとならない。
http://www.geocities.co.jp/SiliconValley-Bay/1992/excel/moji/regtop.html
など参考
どうして混合してしまったのかな。ワードVBAでは使えないと思う。
ーー
それほど考えなくても下記ではどうかな。満たしてないところあるかな。
エクセルの例でテストしたが
Sub test01()
a = Cells(2, "A")
For i = 1 To Len(a)
If IsNumeric(Mid(a, i, 1)) Then
MsgBox "和字は" & Mid(a, 1, i - 1)
MsgBox "数字は" & Right(a, Len(a) - i + 1)
Exit Sub
End If
Next i
End Sub
で和字と英数字が分かれると思うが。
上記のaは　 Selection.Range.Textです。

補足

If IsNumeric(Mid(a, i, 1)) Then
を使いますと、
文字列「第１のセンサ２３ａ」について、
「第」と「１のセンサ２３ａ」とに分かれてしまいました。
この場合は、「第１のセンサ」と「２３ａ」とに分かれるようにしたいのですが。
文字列「センサＰ２３ａ」について、
「センサＰ」と「２３ａ」とに分かれてしまいました。
この場合は、「センサ」と「Ｐ２３ａ」とに分かれるようにしたいのですが。
IsNumericの代わりに、InStrRevは使えますか？