Sub Regulyarki()
Dim objRegexp As RegExp, myMatch As Match, colMatches   As MatchCollection
Dim i, k, myStr As String, CompStr As String, NewStr As String

Set objRegexp = New RegExp
objRegexp.Global = True
objRegexp.IgnoreCase = True
i = 1
myStr = CStr(Cells(1, 1))

While i < Len(myStr)
i = i + 1
    objRegexp.Pattern = "" & Mid(myStr, i, 1) & "(" _
                        & Mid(myStr, i, 1) & "){1,}"
            Set colMatches = objRegexp.Execute(myStr)
            For k = 0 To colMatches.Count - 1
                Set myMatch = colMatches.Item(k)
                CompStr = objRegexp.Replace(myMatch, myMatch.SubMatches(0))
                NewStr = Replace(myStr, myMatch, CompStr)
                myStr = NewStr
                Debug.Print NewStr
            Next k
            
Wend

Cells(2, 1) = myStr
End Sub

Set REdd = New RegExp:  REdd.Global = True: REdd.Pattern = "([A-Za-zЁёА-я])(?:\1)+"
If REdd.test(vl) Then vl = REdd.Replace(vl, "$1")