Function ЗаменитьСимволы_на_крестики(ByVal txt1 As Range) Dim ddd() As String txt = txt1.Value ReDim ddd(Len(txt)) For i = 1 To Len(txt) If Mid(txt, i, 1) = " " Then ddd(i) = " " ElseIf Mid(txt, i, 3) = "ООО" Then ddd(i) = "ООО" i = i + 2 GoTo Next_ ElseIf Mid(txt, i, 3) = "ЗАО" Then ddd(i) = "ЗАО" i = i + 2 GoTo Next_ ElseIf Mid(txt, i, 1) = """" Then ddd(i) = """" GoTo Next_ ElseIf IsNumeric(Mid(txt, i, 1)) Then ddd(i) = Mid(txt, i, 1) GoTo Next_ ElseIf Mid(txt, i, 1) = "," Then ddd(i) = "," GoTo Next_ ElseIf Mid(txt, i, 1) = "." Then ddd(i) = "." GoTo Next_ ElseIf Mid(txt, i, 1) = "%" Then ddd(i) = "%" GoTo Next_ ElseIf Mid(txt, i, 1) = "-" Then ddd(i) = "-" GoTo Next_ ElseIf Mid(txt, i, 1) = "/" Then ddd(i) = "/" GoTo Next_ ElseIf Mid(txt, i, 1) = "»" Then ddd(i) = "»" GoTo Next_ ElseIf Mid(txt, i, 1) = "«" Then ddd(i) = "«" GoTo Next_ Else: ddd(i) = "x" End If Next_: Next i ЗаменитьСимволы_на_крестики = Join(ddd(), "") End Function Sub rrrr() For Each Rng In Selection dd = ЗаменитьСимволы_на_крестики(Rng) ' dd = ЗаменитьСимволы2(Rng) Rng.Value = dd Next 'dff = ЗаменитьСимволы_на_крестики("ООО dddsds ""d"" sd ЗАО ggg4") Debug.Print dff End Sub Function ЗаменитьСимволы2(ByVal txt1 As Range) Dim ddd() As String txt = txt1.Value ReDim ddd(Len(txt)) For i = 1 To Len(txt) If Mid(txt, i, 1) Like "*[а-яё]*" Then ddd(i) = "X" End If Next i ЗаменитьСимволы2 = Join(ddd(), "") End Function