Function TranslitText(RusText As String) As String
Dim RusAlphabet As Variant 'ìàññèâ èç áóêâ ðóññêîãî àëôàâèòà
RusAlphabet = Array("à", "á", "â", "ã", "ä", "å", "¸", "æ", "ç", "è", "é", "ê", "ë", "ì", "í", "î", "ï", "ð", "ñ", "ò", "ó", "ô", "õ", "ö", "÷", "ø", "ù", "ú", "û", "ü", "ý", "þ", "ÿ", " ", ")", "(", "+", ".", ",", "/", " ")
Dim EngAlphabet As Variant 'ìàññèâ èç áóêâ àíãëèéñêîãî àëôàâèòà
EngAlphabet = Array("a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "i", "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "tc", "ch", "sh", "shch", "", "y", "", "e", "iu", "ia", "-", "", "", "", "", "", "", "-")
Dim EngText As String, Letter As String, Flag As Boolean
For i = 1 To Len(RusText) 'öèêë ïî âñåì ñèìâîëàì ðóññêîãî òåêñòà
Letter = Mid(RusText, i, 1)
Flag = 0
For j = 0 To 40 'öèêë ïî âñåì áóêâàì ðóññêîãî àëôàâèòà
If RusAlphabet(j) = LCase(Letter) Then 'åñëè ñèìâîë èç òåêñòà ñîâïàë ñ áóêâîé èç ðóññêîãî àëôàâèòà...
Flag = 1
If RusAlphabet(j) = Letter Then 'ïðîâåðêà íà ðåãèñòð (âåðõíèé èëè íèæíèé)
EngText = EngText & EngAlphabet(j) '... òî äîáàâëÿåì ñîîòâåòñòâóþùóþ áóêâó èç àíãëèéñêîãî àëôàâèòà
Exit For
Else
EngText = EngText & UCase(EngAlphabet(j))
Exit For
End If
End If
Next j
If Flag = 0 Then EngText = EngText & Letter 'åñëè ñèìâîëà èç òåêñòà â àëôàâèòå íåò (íàïðèìåð, çíàêè ïðåïèíàíèÿ è ò.ï.), òî äîáàâëÿåì ñèìâîë áåç èçìåíåíèÿ
Next i
TranslitText = EngText
End Function
Есть такая функция на вба она делает транслит и убирает спецсимволы(скобки, слэш, точки и тд)
Для создания ссылок
И заменят все пробелы дефисами
Но если в ячейке стоит фраза по типу "слово - слово" выходит "слово---слово"
Подскажите как сделать что бы она подчищала еще и --- и --перед завершением своей работы
Я вроде подставил в конец их но не работает
