Function ТолькоСогл$(s$)
Static re As Object
  If re Is Nothing Then
    Set re = CreateObject("vbscript.regexp")
    re.Pattern = "[^бвгджзйклмнпрстфхцчшщ]+"
    re.Global = True
    re.ignorecase = True
  End If
  ТолькоСогл = re.Replace(s, vbNullString)
End Function