Option Explicit
Option Private Module
'====================================================================================================
Sub PRDX_Simplify_Range(rng As Range, Optional OnlyNum As Boolean)
Dim ar As Range
Dim x, arr, arrOne(1 To 1, 1 To 1), r&, c&, flag As Boolean

    For Each ar In rng.Areas
        If ar.Cells.count = 1 Then
            arrOne(1, 1) = ar.Value2
            arr = arrOne
        Else
            arr = ar.Value2
        End If

        For c = 1 To UBound(arr, 2)
            For r = 1 To UBound(arr, 1)
                x = arr(r, c)
                PRDX_Simplify arr(r, c), OnlyNum
                If x <> arr(r, c) Then flag = True
            Next r
        Next c

        If flag Then
            flag = False
            ar.Value2 = arr
        End If
    Next ar
End Sub
'====================================================================================================
Sub PRDX_Simplify(vl, Optional OnlyNum As Boolean)

If IsError(vl) Then Exit Sub
vl = LCase$(Trim(vl)): If Len(vl) = 0 Then vl = Empty: Exit Sub

NumCorrect vl
If OnlyNum Then Extract_Num vl Else Extract vl
End Sub
'====================================================================================================
'====================================================================================================
Private Sub TrimSpace(vl)
Static RE As RegExp

If RE Is Nothing Then Set RE = New RegExp: RE.Global = True: RE.Pattern = " {2,}"
vl = Trim(vl): If RE.Test(vl) Then vl = RE.Replace(vl, " ")
End Sub
'----------------------------------------------------------------------------------------------------
Private Sub Extract(vl)
Dim dicF As Dictionary, x, y, i&
Static RE As RegExp, REcyr As RegExp, dicR As Dictionary

    If RE Is Nothing Then
        Set RE = New RegExp: RE.Global = True: RE.Pattern = "[^•0-9a-zёа-я]"

        x = Array("a", "b", "c", "e", "h", "k", "m", "o", "p", "t", "x", "y", "ё", "й")
        y = Array("а", "в", "с", "е", "н", "к", "м", "о", "р", "т", "х", "у", "е", "и")
        Set dicR = New Dictionary

        For i = 0 To UBound(x)
            dicR.Add x(i), y(i)
        Next i

        Set REcyr = New RegExp
        REcyr.Global = True
        REcyr.Pattern = "[" & Join(x, "") & "]"
    End If

If RE.Test(vl) Then vl = RE.Replace(vl, " ")
TrimSpace vl: If Not REcyr.Test(vl) Then Exit Sub
Set dicF = New Dictionary

    For Each x In REcyr.Execute(vl)
        x = dicF(x)
    Next x

    For i = 0 To dicF.count - 1
        x = dicF.Keys()(i)
        vl = Replace(vl, x, dicR(x))
    Next i
End Sub
'----------------------------------------------------------------------------------------------------
Private Sub Extract_Num(vl)
Static RE As RegExp

If RE Is Nothing Then Set RE = New RegExp: RE.Global = True: RE.Pattern = "[^•0-9]"
If RE.Test(vl) Then vl = RE.Replace(vl, " ")
TrimSpace vl
End Sub
'----------------------------------------------------------------------------------------------------
Private Sub NumCorrect(vl)
Static RE As RegExp, REsp1 As RegExp, REsp2 As RegExp

    If RE Is Nothing Then
        Set RE = New RegExp: RE.Global = True: RE.Pattern = "(\d)(\\|\.|,|-|/)(\d)"
        Set REsp1 = New RegExp: REsp1.Global = True: REsp1.Pattern = "(\D)(\d)"
        Set REsp2 = New RegExp: REsp2.Global = True: REsp2.Pattern = "(\d)(\D)"
    End If

    Do While RE.Test(vl)
        vl = RE.Replace(vl, "$1•$3")
    Loop

If REsp1.Test(vl) Then vl = REsp1.Replace(vl, "$1 $2")
If REsp2.Test(vl) Then vl = REsp2.Replace(vl, "$1 $2")
If InStr(vl, " • ") Then vl = Replace(vl, " • ", "•")
End Sub
'====================================================================================================
'====================================================================================================