Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

11 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【716】Re:文字検索

H. C. Shinopy - 12/1/15(日) 22:42 -


	引用なし

	パスワード

残念ながら簡単には行かないようです。
選択範囲の文字の位置を取り込んで、
Ifステートメントで範囲内かどうか判断しながら処理する方法はありますが、
どうしても範囲外の文字列を検索してしまいますし、
Ifステートメントが悪さをするのか下記の「二重検索」マクロより処理時間が長くなります。

私の場合は、まず正規表現で検索して、
再びFindで検索してカーソルを移動させ書き換えする方法でやっています。
（正規表現のメタキャラクタ（\|()[]{}^$*+?.など）に該当する文字列を検索する場合は、
その前に「\」を付ける必要があるので注意！）

下記のマクロは選択した範囲内の文字列で、
例えば「cx」（あるいは「c^」）・「a_」を検索して、
各々「^」の付いたc、「^」の付いたaに置換する処理です。

また、位置については下記マクロの
Dim myRangeStart As Word.Range
…
Set myRangeStart = Selection.Range ' 検索開始点を取得する。
…
myRangeStart.Select ' 検索開始点に戻る。
を見て下さい。
以下、マクロ。

Sub MyFindReplace()
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　Rem 選択範囲内文字列検索置換処理
　Rem 作譜：Hitrock Camellia Shinopy
　Rem 言語：Word VBA
　Rem 機能...
　Rem　 1. 選択した範囲内で、指定した文字列を検索し置換する。
　Rem 注記...
　Rem　 1. 正規表現で検索した文字列を再度Selection.Findプロパティで検索。
　Rem　 2.
　Rem 履歴...
　Rem　第01版：2010/09/30：作成。
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　Dim myRegExp As Object ' VBScript_RegExp_55.RegExp
　Dim myMatches As Object ' MatchCollection
　Dim myMatch As Object ' Match
　Dim myTextReplace As String
　'
　Dim myRangeStart As Word.Range
　'
　Dim i As Long
　Dim c As Long
　Dim myStatusBar As String
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　'
　If Len(Selection.Range.Text) <= 0 Then
　　Rem 範囲を指定しなかった場合は、カーソルより後で文書の末尾まで選択する。
　　Selection.EndKey Unit:=wdStory, Extend:=wdExtend
　End If
　'
　Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　'
MyFindReplaceSubEntry:
　With myRegExp
　　.Pattern = "[cghjsu][x\^]|[aeiou]_" ' パターンを設定
　　.IgnoreCase = False ' 大文字と小文字を区別する
　　.Global = True ' 文字列全体を検索
　　'
　　If .Test(Selection.Range.Text) = False Then
　　　MsgBox "該当する文字列がありません。"
　　　Selection.Collapse wdCollapseStart
　　　GoTo MyFindReplaceSubExit
　　End If
　　'
　　i = 0
　　Set myMatches = .Execute(Selection.Range.Text)
　　Selection.Collapse wdCollapseStart
　　Set myRangeStart = Selection.Range ' 検索開始点を取得する。
　　'
　　For Each myMatch In myMatches
　　　With Selection.Find
　　　　.Text = myMatch.Value
　　　　.Execute
　　　End With
　　　'
　　　Select Case myMatch.Value
　　　　Case "cx": myTextReplace = ChrW(265)
　　　　Case "c^": myTextReplace = ChrW(265)
　　　　Case "a_": myTextReplace = ChrW(226)
　　　End Select
　　　'
　　　Selection.TypeText myTextReplace ' 置き換え。
　　　'
　　　i = i + 1
　　　c = i * 100 \ myMatches.Count
　　　myStatusBar = Format(c, "##0") & "%　" & i & "/" & myMatches.Count & "件"
　　　Application.StatusBar = "MyFindReplace" & "：処理中" & " " & myStatusBar
　　　DoEvents
　　Next ' myMatch
　End With
　'
　myRangeStart.Select ' 検索開始点に戻る。
　Rem *----*----*　　*----*----*　　*----*----*　　*----*----*
　'
MyFindReplaceSubExit:
　Set myRegExp = Nothing
　Set myMatches = Nothing
　Set myRangeStart = Nothing
　Application.StatusBar = "MyFindReplace" & "：" & "処理完了！"
End Sub ' MyFindReplace *----*----*　　*----*----*　　*----*----*　　*----*----*

[End]