Поиск и замена в зависимости от впередиидущей цифры

Sub ak_Kones()
Dim sText As Range
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
Set sText = ActiveDocument.Range
vFindText = Array("^? коней.")
 
InputText = vFindText(i)
Set RegEx = CreateObject("VBScript.RegExp")
 With RegEx
 .Global = True
 .Pattern = "[^\dA-Za-z+]"
 Summa = .Replace(InputText, "")
 End With
 
PartNum = Int(Val(Summa))
If PartNum = 0 Then
    NumStr = NumStr & "коней"
  Else
    ' выделение цифры единиц
    NumTMP = PartNum
    Select Case NumTMP
    Case 1
      If PartNum <> 11 Then
        NumStr = NumStr & "конь"
      Else
        NumStr = NumStr & "коней"
      End If
      Case 2, 3, 4
        If (PartNum < 5) Or (PartNum > 14) Then
          NumStr = NumStr & "коня"
        Else
          NumStr = NumStr & "коней"
        End If
      Case Else
        NumStr = NumStr & "коней"
    End Select
  End If
 
vReplText = Array(NumStr)
 
With sText.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True
For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute Replace:=wdReplaceAll
Next i
End With
End Sub