Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

Функция по замене букв текста на другие символа (аналогично переводу в транслит)

Автор Snekich, 17.11.2011, 17:59

« назад - далее »

Snekich

КРАТКО:
Нужна функция.
В функции прописан набор символов, например "абвгдеёжз"
И другой набор символов, например "123456789"
И функция переделывала бы текст, который состоит из первого набора символов, в текст который состоит из второго набора символов соответственно.
Например исходный текст "беда", а результат "2651".

ПОДРОБНО:
В одной ячейке есть текст в кириллице.
Например, "Мама мыла раму."
Как в другой ячейке получить этот текст в однобитном UTF ?
Для приведенного примера будет что-то наподобии:
"D0 9C D0 B0 D0 BC D0 B0 20 D0 BC D1 8B D0 BB D0 B0 20 D1 80 D0 B0 D0 BC D1 83."

Есть словарь как кириллицу (и прочее) в UTF перевести
словарь

Собственно нужную "выдержку" из этого словаря с скопировал отдельно в файл.
Плюс в файле есть функция по переводу текста в транслит.
Думаю перевод в UTF будет похожим, но в силу своего небольшого опыта я не знаю как переделать эту функцию.

Может что-то наподобии (эта не работает, надо исправить какую-то ошибку):

Public Function ToUTF(ByVal txt As String) As String
iRussianLower$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
iTranslit = Array("", _
"d0 b0 ", "d0 b1 ", "d0 b2 ", _
"d0 b3 ", "d0 b4 ", "d0 b5 ", _
"d1 91 ", "d0 b6 ", "d0 b7 ", _
"d0 b8 ", "d0 b9 ", "d0 ba ", _
"d0 bb ", "d0 bc ", "d0 bd ", _
"d0 be ", "d0 bf ", "d1 80 ", _
"d1 81 ", "d1 82 ", "d1 83 ", _
"d1 84 ", "d1 85 ", "d1 86 ", _
"d1 87 ", "d1 88 ", "d1 89 ", _
"d1 8a ", "d1 8b ", "d1 8c ", _
"d1 8d", "d1 8e ", "d1 8f ")

Dim result$, char$, newChar$, charIndex%
For i% = 1 To Len(txt)
char = Mid(txt, i, 1)
charIndex = InStr(1, iRussianLower, char, vbTextCompare)
If (charIndex >= 1) Then
newChar = iTranslit(charIndex)
Else
newChar = char
End If
result = result & newChar
Next i
Translit$ = result
End Function


Вот тут еще воде бы можно подчерпнуть полезную информацию, но у меня не получается ее пристроить для своих целей.
ссылка

Помогите пожалуйста

Snekich

Public Function ToUTF(ByVal txt As String) As String
iRussianLower$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
iTranslit = Array("", _
"d0 b0 ", "d0 b1 ", "d0 b2 ", _
"d0 b3 ", "d0 b4 ", "d0 b5 ", _
"d1 91 ", "d0 b6 ", "d0 b7 ", _
"d0 b8 ", "d0 b9 ", "d0 ba ", _
"d0 bb ", "d0 bc ", "d0 bd ", _
"d0 be ", "d0 bf ", "d1 80 ", _
"d1 81 ", "d1 82 ", "d1 83 ", _
"d1 84 ", "d1 85 ", "d1 86 ", _
"d1 87 ", "d1 88 ", "d1 89 ", _
"d1 8a ", "d1 8b ", "d1 8c ", _
"d1 8d", "d1 8e ", "d1 8f ")

Dim result$, char$, newChar$, charIndex%
For i% = 1 To Len(txt)
char = Mid(txt, i, 1)
charIndex = InStr(1, iRussianLower, char, vbTextCompare)
If (charIndex >= 1) Then
newChar = iTranslit(charIndex)
Else
newChar = char
End If
result = result & newChar
Next i
ToUTF$ = result
End Function

Ошибку исправил. Если есть более удобные вырианты, то давайте обсудим

Wasilic

Не занимался я этим, но вижу такой вариант.
Может и я на что сгожусь ... Если сгодился, можете меня по+благодарить+.

Snekich

Цитата: Wasilic от 18.11.2011, 01:53
Не занимался я этим, но вижу такой вариант.
Кстати хороший вариант, главное универсальный.