Заменить символы на крестики

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

Добавить комментарий

Ваш адрес email не будет опубликован.