Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос по Переводу букв с кириллицу на латиницу, Макрос по работе с номерами машин
 
#1
28.10.2017 13:52:08
Добрый день, уважаемые гении!!

Во вложении файл, где есть перечень номеров, которые заполнены неверно: невозможно работать в дальнейшем.

Нужно:
1. Перевести буквы с кириллицы на латинский (в случае необходимости), например русское О на латинскую O. (измененные буквы закрашивать в красный)
2. Убрать все пробелы (Подставить(" ";"") не работает иногда, пробел почему то остается, в последнем случае например)
3. Во всех случаях, когда номер начинается с "70" "80" "95" нужно после них поставить "/", если его нету

Можно ли с этим что нибудь сделать?
Попадался ли кто уже работал с номерами машин?
Чайникам куда труднее, чем кажется!!
 
 
 
#2
28.10.2017 14:44:21
Не попадался.Наваял пример функции, переделаете в процедуру и допилите под себя.
Скрытый текст
 
 
 
#3
28.10.2017 15:03:09
Цитата
Doober написал: допилите под себя.
не получается
Чайникам куда труднее, чем кажется!!
 
 
 
#4
28.10.2017 15:06:10
Xanuman, в Вашей предыдущей теме выкладывал вариант
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
28.10.2017 15:28:26
Можно использовать перую попавшуюся транслитерацию:
Код
'преобразует кирилицу в латиницу не меняя отображение
Function translit_(slv As String) As String
    Dim rus, lat, sli As String, sss As String, ssi As String
    Dim ll As Long, i As Long, j As Byte

    rus = Array("а", "в", "е", "х", "к", "м", "н", "о", "р", "с", "т", "А", "В", "К", "М", "Н", "О", "Р", "С", "Т", "Х", Chr(160), " ")
    lat = Array("a", "b", "e", "x", "k", "m", "h", "o", "p", "c", "t", "A", "B", "K", "M", "H", "O", "P", "C", "T", "X", "", "")
    ll = Len(slv)
    For i = 1 To ll
        sli = Mid(slv, i, 1)
        For j = 0 To 22
            If sli = rus(j) Then
                sss = lat(j)
                Exit For
            Else: sss = sli
            End If
        Next j
        ssi = ssi & sss
    Next i
    translit_ = ssi
End Function

Ну а плюшку с слэшами можно приладить в конце отдельно или навесить другую UDF, т.к. выше уже показано.
 
 
 
#6
30.10.2017 13:19:13
Hugo, cant execute code in break mode пишет. Вот что вставляю в макрос:


Sub тачки()
Function translit_(slv As String) As String
   Dim rus, lat, sli As String, sss As String, ssi As String
   Dim ll As Long, i As Long, j As Byte

   rus = Array("а", "в", "е", "х", "к", "м", "н", "о", "р", "с", "т", "А", "В", "К", "М", "Н", "О", "Р", "С", "Т", "Х", Chr(160), " ")
   lat = Array("a", "b", "e", "x", "k", "m", "h", "o", "p", "c", "t", "A", "B", "K", "M", "H", "O", "P", "C", "T", "X", "", "")
   ll = Len(slv)
   For i = 1 To ll
       sli = Mid(slv, i, 1)
       For j = 0 To 22
           If sli = rus(j) Then
               sss = lat(j)
               Exit For
           Else: sss = sli
           End If
       Next j
       ssi = ssi & sss
   Next i
   translit_ = ssi

End Function
Чайникам куда труднее, чем кажется!!
 
 
 
#7
30.10.2017 13:19:43
А теперь вернитесь и приведите код в порядок
 
 
 
#8
30.10.2017 13:25:43
Цитата
Xanuman написал:
cant execute code in break mode пишет
А Вы не пробовали перевести это сообщение?
Xanuman, ну ведь не первый день на форуме - когда научитесь оформлять код нужным тегом?
 
 
 
#9
30.10.2017 14:44:18
Цитата
Юрий М написал:
когда научитесь оформлять код нужным тегом?
Обязательно займусь этим в скором будущем! Не могли бы Вы мне литературу посоветовать?
А за одно сказать решение данной проблемы: я End Sub делаю, все равно не работает
Чайникам куда труднее, чем кажется!!
 
 
 
#10
30.10.2017 14:48:02
Про какую ЛИТЕРАТУРУ Вы говорите??? Найдите такую кнопку и с её помощью отформатируйте код.
Посмотрите, как он выглядит у других, и как у Вас.
 
 
 
Страницы: 1
Наверх