Sub MyFixPeppersCase3()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem 選択範囲内 正規表現指定 文字列検索 条件別置換処理（例）
  Rem 作譜：Hitrock Camellia Shinopy
  Rem 言語：Word VBA
  Rem 機能...
  Rem   1. マウスでドラッグして選択した範囲を検索・置換する。
  Rem   2. 下記の文字列を検索する。
  Rem      ・「red pepper」または「green pepper」を「bell pepper」に置換する。
  Rem        但し、この処理では「red pepper」を「green pepper」に置き換えるよう条件を追加して指定。
  Rem      ・但し、「pepper」以降の同じ段落に「salad」が存在する場合のみ置換する。
  Rem      ・但し、「pepper」の直後に「corn」が続く場合は置換しない。
  Rem 注記...
  Rem   1. このマクロを実行すると、それまでの操作は[元に戻す]ボックスから消されます。
  Rem   2. 下記から引用して手直しして作成...
  Rem        Andrew Savikas 著『Word Hacks プロが教える文書活用テクニック』オライリー・ジャパン 刊
  Rem          4章 便利な編集テクニック　Hack #30 正規表現を使って検索する。
  Rem 履歴...
  Rem   第01版：2013/10/06：作成。
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Dim myRegExp As Object ' VBScript_RegExp_55.RegExp
  Dim myMatch As Object ' Match
  Dim myMatches As Object ' MatchCollection
  Dim myPttn As String
  '
  Dim myRange As Object ' Range
  Dim myRangeEnd As Object ' Range
  '
  Dim i As Long
  Dim c As Long
  Dim myMoveRightCount As Long
  Dim myFirstIndexPrev As Long
  Dim myReplaceText As String
  Dim myTitle As String
  Dim myStatusBar As String
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  If Len(Selection.Range.Text) <= 0 Then Exit Sub
  ActiveDocument.UndoClear ' [元に戻す]の履歴を消去する。
  myTitle = "MyFixPeppersCase3"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  myPttn = "\b(red|green)([ ]+pepper(?!corn)(?=[^\r]*\bsalads?\b))"
  '  myPttn = "\b(red|green)(\s+pepper(?!corn)(?=.*salad))"
  '
  Set myRegExp = CreateObject("VBScript.RegExp")
  With myRegExp
    .Pattern = myPttn
    .IgnoreCase = True ' 大文字と小文字を区別しない。
    .Global = True
  End With
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.ScreenUpdating = False
  '
  Set myRange = Selection.Range
  Set myMatches = myRegExp.Execute(myRange.Text)
  '
  Selection.Collapse wdCollapseEnd
  Set myRangeEnd = Selection.Range
  myRange.Select
  Selection.Collapse wdCollapseStart
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  i = 0
  c = 0
  myFirstIndexPrev = 0
  '
  For Each myMatch In myMatches
    i = i + 1
    c = i * 100 \ myMatches.Count
    myStatusBar = Format(c, "##0") & "%　" & i & "/" & myMatches.Count & "件"
    Application.StatusBar = myTitle & "：処理中 " & myStatusBar
    '
    myMoveRightCount = myMatch.FirstIndex - myFirstIndexPrev
    Selection.MoveRight Unit:=wdCharacter, Count:=myMoveRightCount ' 検索文字列の直前にカーソルに移動する。
    With Selection.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = myMatch.Value
      .Wrap = wdFindStop
      .MatchCase = False ' 大文字と小文字を区別しない。
      '
      Select Case True ' 置換文字列を条件別に設定する。
        Case myMatch.SubMatches.Item(0) Like "[Rr]ed"
          myReplaceText = "green" & myMatch.SubMatches.Item(1)
        Case Else
          myReplaceText = "bell" & myMatch.SubMatches.Item(1)
      End Select
      '
      .Replacement.Text = myReplaceText
      .Execute Replace:=wdReplaceOne ' カーソル移動・検索・置換。
    End With
    Selection.Collapse wdCollapseEnd ' 検索文字列の末尾にカーソルを移動する。
    myFirstIndexPrev = myMatch.FirstIndex + myMatch.Length
    '
    DoEvents
  Next ' myMatch
  '
  myRangeEnd.Select ' 選択範囲の末尾にカーソルを移動する。
  myStatusBar = Format(c, "##0") & "%　" & i & "/" & myMatches.Count & "件"
  Application.StatusBar = "myTitle & ": 処理終了! " & myStatusBar"
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  '
  Application.ScreenUpdating = True
  '
  Set myRegExp = Nothing
  Set myMatches = Nothing
  Set myRange = Nothing
  Set myRangeEnd = Nothing
End Sub ' MyFixPeppersCase3 *----*----*    *----*----*    *----*----*    *----*----*