Sub УБРАТЬ_ЛИШНИЕ_ПРОБЕЛЫ()
'---------------------------------------------------------------------------------------
' Procedure    : УБРАТЬ_ЛИШНИЕ_ПРОБЕЛЫ
' Author       : KuklP
' Purpose      : убрать многократные пробелы и пробелы перед некоторыми знаками пунктуации
' Notes        :
'---------------------------------------------------------------------------------------
       If Selection.Type <> wdSelectionNormal Then Exit Sub
       Dim i%, sPunkt$
       sPunkt = ".,;:!?)" & Chr(133)       ' список знаков пунктуации, перед которыми нужно убирать пробелы
       With Selection.Find
       For i = 1 To Len(sPunkt)      ' убрать пробелы перед знаками пунктуации
          .Execute "^w" & Mid(sPunkt, i, 1), , , 0, , , , , 0, Mid(sPunkt, i, 1) & " ", 2
       Next
          .Execute "^w", , , 0, , , , , 0, " ", 2        ' заменить множественные пробелы на один
          .Execute "^p^w", , , 0, , , , , 0, "^p", 2     ' убрать пробелы в начале абзаца (после ^p)
          .Execute "^w^p", , , 0, , , , , 0, "^p", 2    ' убрать пробелы в конце абзаца (перед ^p)
       End With
End Sub

.Execute "^w", , , 0, , , , , 0, " ", 2

Sub УБРАТЬ_ЛИШНИЕ_ПРОБЕЛЫ()
'---------------------------------------------------------------------------------------
' Procedure    : УБРАТЬ_ЛИШНИЕ_ПРОБЕЛЫ
' Author       : KuklP & Alex_ST
' Purpose      : убрать в выделенном тексте многократные пробелы и пробелы перед некоторыми знаками пунктуации
' Notes        :
' URL          : http://www.excelworld.ru/forum/4-1127-13907-16-1326718916
'---------------------------------------------------------------------------------------
        If Selection.Type <> wdSelectionNormal Then Exit Sub
        With Selection.Find
           .ClearFormatting   ' очистить условия поиска по формату (они могли сохраниться от предыдущих ручных поисков/замен)
           .Execute "[ ^s^t]{1;}([.,:;…\!\?\)])", , , -1, , , , 0, 0, "\1", 2 ' убрать обычные и неразрывные пробелы и табуляции перед знаками препинания .,:;…!?)
           .Execute "^w", , , 0, , , , 0, 0, " ", 2          ' заменить множественные пробелы на один
           .Execute "^p^w", , , 0, , , , 0, 0, "^p", 2      ' убрать пробелы в начале абзаца (после ^p)
           .Execute "^w^p", , , 0, , , , 0, 0, "^p", 2     ' убрать пробелы в конце абзаца (перед ^p)
        End With
End Sub

Sub io()
With CreateObject("VBScript.RegExp")
      .Global = True
      .MultiLine = True
      .Pattern = "^[\t ]+|[\t ](?=[\t ]|[(.,:;…!?)])|[\t ]$"
      Selection.Text = .Replace(Selection.Text, "")
End With
End Sub

.Pattern = "^[\t ]+|[\t ](?=[\t ]|[(.,:;…!?)])|[\t ]$"

Sub ПрощайФормат()
        Dim s As String
        s = Selection.Text
        Selection.Text = Left(s, Len(s) - 1)
End Sub

Sub io()
Dim x As String
x = ActiveCell.Value
With CreateObject("VBScript.RegExp")
     .Global = True
     .MultiLine = True
     .Pattern = "\n+|\t+"
     x = .Replace(x, " ")
     .Pattern = "^\s+|\s+$|\s+(?=[\s.,:;…!?)])"
     ActiveCell.Value = .Replace(x, "")
End With
End Sub

Sub io()
MsgBox ActiveCell.HasFormula ' true = formula
MsgBox UsedRange.SpecialCells(2).Address
End Sub