Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.11.2016, 18:20   #21
EIKA
Новичок
Джуниор
 
Регистрация: 10.11.2016
Сообщений: 1
По умолчанию

Ребята, помогите, пожалуйста.

Есть модуль транслитерации кириллицы в латиницу http://www.planetaexcel.ru/techniques/7/32/ для Excel

Также в этом модуле я делаю замену ненужных мне символов, типа #&{}() и так далее на нижнее подчеркивание. Так вот, нужно также автозаменять в том числе пробелы и двойную непарную кавычку ("). Конечная цель - получать web safe URL в Excel.

Пробовал играться с Char(32), Char(34) и Char(160), и ничего.

С непарной кавычкой вообще загадка - изоляция двойными кавычками невозможна, так как непарная кавычка делает код невалидным. Защитный слэш в VB не работает. Char(34) не срабатывает.

Помогите, пожалуйста, допилить код. Сейчас такой:

Код:
Function Translit(Txt As String) As String
 
    Dim Rus As Variant
    Rus = Array("à", "á", "â", "ã", "ä", "å", "¸", "æ", "ç", "è", "é", "ê", _
    "ë", "ì", "í", "î", "ï", "ð", "ñ", "ò", "ó", "ô", "õ", "ö", "÷", "ø", _
    "ù", "ú", "û", "ü", "ý", "þ", "ÿ", "À", "Á", "Â", "Ã", "Ä", "Å", _
    "¨", "Æ", "Ç", "È", "É", "Ê", "Ë", "Ì", "Í", "Î", "Ï", "Ð", _
    "Ñ", "Ò", "Ó", "Ô", "Õ", "Ö", "×", "Ø", "Ù", "Ú", "Û", "Ü", "Ý", "Þ", "ß", _
    "/", "\", "!", "#", "$", "%", "&", "(", ")", "*", "+", ".", "@", ":", ";", _
    ",", "<", ">", "=", "[", "]", "^", "`", "{", "}", "|", "~", "?", "'", "Chr(160)", "Chr(32)", "-")
 
    Dim Eng As Variant
    Eng = Array("a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "j", _
    "k", "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", _
    "sh", "sch", "''", "y", "'", "e", "yu", "ya", "A", "B", "V", "G", "D", _
    "E", "JO", "ZH", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", _
    "S", "T", "U", "F", "KH", "TS", "CH", "SH", "SCH", "''", "Y", "'", "E", "YU", "YA", _
    "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", _
    "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_")
     
    For I = 1 To Len(Txt)
        ñ = Mid(Txt, I, 1)
     
        flag = 0
        For J = 0 To 96
            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
Код работает как надо, кроме пробела и двойной непарной кавычки.

Последний раз редактировалось EIKA; 10.11.2016 в 18:23.
EIKA вне форума Ответить с цитированием
Старый 10.11.2016, 21:43   #22
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Непонятно в чем проблема. Все меняется
Код:
Function Translit(Txt As String) As String
 
    Dim Rus As Variant
    Rus = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", _
    "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _
    "щ", "ъ", "ы", "ь", "э", "ю", "я", "А", "Б", "В", "Г", "Д", "Е", _
    "Ё", "Ж", "З", "И", "Й", "К", "Л", "М", "Н", "О", "П", "Р", _
    "С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ", "Ы", "Ь", "Э", "Ю", "Я", _
     "/", "\", "!", "#", "$", "%", "&", "(", ")", "*", "+", ".", "@", ":", ";", _
    ",", "<", ">", "=", "[", "]", "^", "`", "{", "}", "|", "~", "?", "'", "Chr(160)", "Chr(32)", "-", _
    " ", """")
 
    Dim Eng As Variant
    Eng = Array("a", "b", "v", "g", "d", "e", "jo", "zh", "z", "i", "j", "k", _
    "l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "ts", "ch", "sh", _
    "sch", "''", "y", "'", "e", "yu", "ya", "A", "B", "V", "G", "D", "E", _
    "JO", "ZH", "Z", "I", "J", "K", "L", "M", "N", "O", "P", "R", _
    "S", "T", "U", "F", "KH", "TS", "CH", "SH", "SCH", "''", "Y", "'", "E", "YU", "YA", _
    "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", _
    "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", "_", _
    "_", "_")
     
    For I = 1 To Len(Txt)
        с = Mid(Txt, I, 1)
     
        flag = 0
        For J = 0 To UBound(Rus)
            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
     
    Translit2 = outstr
     
End Function
только, думаю, что замену на "_" можна делать в секции if flag then... а не плодить массив
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.

Последний раз редактировалось Aleksandr H.; 10.11.2016 в 21:53.
Aleksandr H. вне форума Ответить с цитированием
Старый 11.11.2016, 01:26   #23
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

Код работает как надо, кроме пробела и двойной непарной кавычки
Насчет пробела - неудивительно, когда в массиве "Chr(32)" вместо " ".
А во что должна превращаться "двойная непарная кавычка"? (хотя какая она непарная, если она двойная )
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Количество пробелов до конца строки Qv_1 Microsoft Office Word 8 01.06.2009 19:58
Аналог функции Trim-удаление лишних пробелов в начале и в конце передаваемой строки GULINA Помощь студентам 6 23.05.2009 15:07
Удаление пробелов Иван 883 Помощь студентам 1 20.04.2009 22:23
Удаление лишних пробелов. Ввод/вывод в файл. Иван 883 Помощь студентам 13 31.03.2009 19:39
Строки(удаление пробелов). C language SuccEssoR Помощь студентам 4 15.01.2009 17:13