it3
29-08-2019, 08:15
Подскажите пожалуйста, каким образом реализовать следующее:
Есть ячейка с ФИО (Задаётся вручную): Иванов Иван Иванович
Необходимо чтобы в следующей ячейке был транслитерация (Выводится автоматически): Ivanov Ivan Ivanovich
В следующей ячейке (Выводится автоматически): ivanov.ii
В следующей ячейке (Выводится автоматически): Ivan.Ivanov
В принципе с транслитерацией нет проблем. Использую такой модуль:
Function Translit(Txt As String) As String
Dim Rus As Variant
Rus = Array("à", "á", "â", "ã", "ä", "å", "¸", "æ", "ç", "è", "é", "ê", _
"ë", "ì", "í", "î", "ï", "ð", "ñ", "ò", "ó", "ô", "õ", "ö", "÷", "ø", _
"ù", "ú", "û", "ü", "ý", "þ", "ÿ", "À", "Á", "Â", "Ã", "Ä", "Å", _
"¨", "Æ", "Ç", "È", "É", "Ê", "Ë", "Ì", "Í", "Î", "Ï", "Ð", _
"Ñ", "Ò", "Ó", "Ô", "Õ", "Ö", "×", "Ø", "Ù", "Ú", "Û", "Ü", "Ý", "Þ", "ß")
Dim Eng As Variant
Eng = Array("a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "i", _
"k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", _
"sh", "sh", "", "y", "", "e", "iu", "ia", "A", "B", "V", "G", "D", _
"E", "E", "ZH", "Z", "I", "I", "K", "L", "M", "N", "O", "P", "R", _
"S", "T", "U", "F", "KH", "TS", "CH", "SH", "SH", "", "Y", "", "E", "IU", "IA")
For I = 1 To Len(Txt)
ñ = Mid(Txt, I, 1)
flag = 0
For J = 0 To 65
If Rus(J) = ñ Then
outchr = Eng(J)
flag = 1
Exit For
End If
Next J
If flag Then outstr = outstr & outchr Else outstr = outstr & ñ
Next I
Translit = outstr
End Function
Есть ячейка с ФИО (Задаётся вручную): Иванов Иван Иванович
Необходимо чтобы в следующей ячейке был транслитерация (Выводится автоматически): Ivanov Ivan Ivanovich
В следующей ячейке (Выводится автоматически): ivanov.ii
В следующей ячейке (Выводится автоматически): Ivan.Ivanov
В принципе с транслитерацией нет проблем. Использую такой модуль:
Function Translit(Txt As String) As String
Dim Rus As Variant
Rus = Array("à", "á", "â", "ã", "ä", "å", "¸", "æ", "ç", "è", "é", "ê", _
"ë", "ì", "í", "î", "ï", "ð", "ñ", "ò", "ó", "ô", "õ", "ö", "÷", "ø", _
"ù", "ú", "û", "ü", "ý", "þ", "ÿ", "À", "Á", "Â", "Ã", "Ä", "Å", _
"¨", "Æ", "Ç", "È", "É", "Ê", "Ë", "Ì", "Í", "Î", "Ï", "Ð", _
"Ñ", "Ò", "Ó", "Ô", "Õ", "Ö", "×", "Ø", "Ù", "Ú", "Û", "Ü", "Ý", "Þ", "ß")
Dim Eng As Variant
Eng = Array("a", "b", "v", "g", "d", "e", "e", "zh", "z", "i", "i", _
"k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", _
"sh", "sh", "", "y", "", "e", "iu", "ia", "A", "B", "V", "G", "D", _
"E", "E", "ZH", "Z", "I", "I", "K", "L", "M", "N", "O", "P", "R", _
"S", "T", "U", "F", "KH", "TS", "CH", "SH", "SH", "", "Y", "", "E", "IU", "IA")
For I = 1 To Len(Txt)
ñ = Mid(Txt, I, 1)
flag = 0
For J = 0 To 65
If Rus(J) = ñ Then
outchr = Eng(J)
flag = 1
Exit For
End If
Next J
If flag Then outstr = outstr & outchr Else outstr = outstr & ñ
Next I
Translit = outstr
End Function