Форум программистов, компьютерный форум, киберфорум
VBA
Форум программистов и сисадминов Киберфорум > Форум программистов > Basic > VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
5 / 5 / 1
Регистрация: 03.05.2015
Сообщений: 14

Написание русского слова английскими буквами

03.05.2015, 09:34. Показов 1051. Ответов 4
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
Всем доброго времени суток!
Я написал программу, которая записывает русские слова английскими буквами, но она получилась слишком длинной.
Подскажите, как её можно сократить?

Visual Basic Скопировано
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155

Public Function РусАнглстрока(s As String)
Dim l As Long, i As Long, j As Long, n As String
j = 0
s = Trim(s)
l = Len(s)
For i = 1 To l
n = Mid(n, 1, i - 1) & ""
Next i
For i = 1 To l
j = j + 1
Select Case Mid(s, i, 1)
Case "А"
n = Mid(n, 1, j - 1) & "A" & Mid(n, j + 1)
Case "а"
n = Mid(n, 1, j - 1) & "a" & Mid(n, j + 1)
Case "Б"
n = Mid(n, 1, j - 1) & "B" & Mid(n, j + 1)
Case "б"
n = Mid(n, 1, j - 1) & "b" & Mid(n, j + 1)
Case "В"
n = Mid(n, 1, j - 1) & "V" & Mid(n, j + 1)
Case "в"
n = Mid(n, 1, j - 1) & "v" & Mid(n, j + 1)
Case "Г"
n = Mid(n, 1, j - 1) & "G" & Mid(n, j + 1)
Case "г"
n = Mid(n, 1, j - 1) & "g" & Mid(n, j + 1)
Case "Д"
n = Mid(n, 1, j - 1) & "D" & Mid(n, j + 1)
Case "д"
n = Mid(n, 1, j - 1) & "d" & Mid(n, j + 1)
Case "Е"
n = Mid(n, 1, j - 1) & "E" & Mid(n, j + 1)
Case "е"
n = Mid(n, 1, j - 1) & "e" & Mid(n, j + 1)
Case "Ё"
j = j + 2
n = Mid(n, 1, j - 2) & "Yо" & Mid(n, j + 1)
Case "ё"
j = j + 2
n = Mid(n, 1, j - 1) & "yo" & Mid(n, j + 1)
Case "Ж"
n = Mid(n, 1, j - 1) & "G" & Mid(n, j + 1)
Case "ж"
n = Mid(n, 1, j - 1) & "g" & Mid(n, j + 1)
Case "З"
n = Mid(n, 1, j - 1) & "Z" & Mid(n, j + 1)
Case "з"
n = Mid(n, 1, j - 1) & "z" & Mid(n, j + 1)
Case "И"
n = Mid(n, 1, j - 1) & "I" & Mid(n, j + 1)
Case "и"
n = Mid(n, 1, j - 1) & "i" & Mid(n, j + 1)
Case "Й"
n = Mid(n, 1, j - 1) & "Y" & Mid(n, j + 1)
Case "й"
n = Mid(n, 1, j - 1) & "y" & Mid(n, j + 1)
Case "К"
n = Mid(n, 1, j - 1) & "K" & Mid(n, j + 1)
Case "к"
n = Mid(n, 1, j - 1) & "k" & Mid(n, j + 1)
Case "Л"
n = Mid(n, 1, j - 1) & "L" & Mid(n, j + 1)
Case "л"
n = Mid(n, 1, j - 1) & "l" & Mid(n, j + 1)
Case "М"
n = Mid(n, 1, j - 1) & "M" & Mid(n, j + 1)
Case "м"
n = Mid(n, 1, j - 1) & "m" & Mid(n, j + 1)
Case "Н"
n = Mid(n, 1, j - 1) & "N" & Mid(n, j + 1)
Case "н"
n = Mid(n, 1, j - 1) & "n" & Mid(n, j + 1)
Case "О"
n = Mid(n, 1, j - 1) & "O" & Mid(n, j + 1)
Case "о"
n = Mid(n, 1, j - 1) & "o" & Mid(n, j + 1)
Case "П"
n = Mid(n, 1, j - 1) & "P" & Mid(n, j + 1)
Case "п"
n = Mid(n, 1, j - 1) & "p" & Mid(n, j + 1)
Case "Р"
n = Mid(n, 1, j - 1) & "R" & Mid(n, j + 1)
Case "р"
n = Mid(n, 1, j - 1) & "r" & Mid(n, j + 1)
Case "С"
n = Mid(n, 1, j - 1) & "S" & Mid(n, j + 1)
Case "с"
n = Mid(n, 1, j - 1) & "s" & Mid(n, j + 1)
Case "Т"
n = Mid(n, 1, j - 1) & "T" & Mid(n, j + 1)
Case "т"
n = Mid(n, 1, j - 1) & "t" & Mid(n, j + 1)
Case "У"
n = Mid(n, 1, j - 1) & "U" & Mid(n, j + 1)
Case "у"
n = Mid(n, 1, j - 1) & "u" & Mid(n, j + 1)
Case "Ф"
n = Mid(n, 1, j - 1) & "F" & Mid(n, j + 1)
Case "ф"
n = Mid(n, 1, j - 1) & "f" & Mid(n, j + 1)
Case "Х"
n = Mid(n, 1, j - 1) & "H" & Mid(n, j + 1)
Case "х"
n = Mid(n, 1, j - 1) & "h" & Mid(n, j + 1)
Case "Ц"
j = j + 2
n = Mid(n, 1, j - 1) & "Ts" & Mid(n, j + 1)
Case "ц"
j = j + 2
n = Mid(n, 1, j - 1) & "ts" & Mid(n, j + 1)
Case "Ч"
j = j + 2
n = Mid(n, 1, j - 2) & "Ch" & Mid(n, j + 1)
Case "ч"
j = j + 2
n = Mid(n, 1, j - 1) & "ch" & Mid(n, j + 1)
Case "Ш"
j = j + 1
n = Mid(n, 1, j - 1) & "Sh" & Mid(n, j + 1)
Case "ш"
j = j + 1
n = Mid(n, 1, j - 1) & "sh" & Mid(n, j + 1)
Case "Щ"
j = j + 2
n = Mid(n, 1, j - 2) & "SCH" & Mid(n, j + 1)
Case "щ"
j = j + 2
n = Mid(n, 1, j - 2) & "sch" & Mid(n, j + 1)
Case "ъ"
n = Mid(n, 1, j - 1) & "'" & Mid(n, j + 1)
Case "ы"
n = Mid(n, 1, j - 1) & "y" & Mid(n, j + 1)
Case "ь"
n = Mid(n, 1, j - 1) & "s" & Mid(n, j + 1)
Case "Э"
n = Mid(n, 1, j - 1) & "E" & Mid(n, j + 1)
Case "э"
n = Mid(n, 1, j - 1) & "e" & Mid(n, j + 1)
Case "Ю"
n = Mid(n, 1, j - 1) & "U" & Mid(n, j + 1)
Case "ю"
n = Mid(n, 1, j - 1) & "u" & Mid(n, j + 1)
Case "Я"
j = j + 1
n = Mid(n, 1, j - 1) & "YA" & Mid(n, j + 1)
Case "я"
j = j + 1
n = Mid(n, 1, j - 1) & "ya" & Mid(n, j + 1)
Case " "
n = Mid(n, 1, j - 1) & " " & Mid(n, j + 1)
End Select
Next i
РусАнглстрока = n
End Function
0
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
 03.05.2015, 09:34
Ответы с готовыми решениями:

Русский текст английскими буквами
День добрый! Ищу макрос, который переделает Русский текст, набранный английскими буквами в нормальный текст. Чтото типа этого,...

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

Гласные заменяются английскими буквами в сообщениях агента Mail.ru
Подскажите пожалуйста в чем может быть причина? В сообщениях агента Mail.ru при наборе гласных букв автоматически подставляются...

4
15155 / 6428 / 1731
Регистрация: 24.09.2011
Сообщений: 9,999
03.05.2015, 13:29
Функция для транслита русского языка
0
Заблокирован
04.05.2015, 06:46
Цитата Сообщение от Виктор9696
Подскажите, как её можно сократить?
Visual Basic Скопировано
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

Option Explicit
'---------------------------------------------------------------------------------------
' Программа    : Транслитерация русского текста
' Дата и время    : 04 мая 2015  06:45
' Автор            : Night Ranger
'                 Яндекс.Деньги - 410012757639478
'                 [email]Exingsteem@yandex.ru[/email]
'                 [url]https://www.cyberforum.ru/vba/[/url]
' Описание      : Программа для быстрой транслитерации
'                 Необходимо создать форму, скопировать в её модуль этот текст и запустить, всё.. ничего больше делать не надо
'---------------------------------------------------------------------------------------
Dim WithEvents txRus As msforms.TextBox
Dim WithEvents txEng As msforms.TextBox
Dim i&, j&, rus$(), eng$(), dic As Object
 
Private Sub txRus_Change()
    Dim j&, n&, s$, sb$, caseBool As Boolean
    sb = Space$(Len(txRus) * 2)
    For i = 1 To Len(txRus)
        j = j + 1: s = Mid$(txRus, i, 1)
        caseBool = s = UCase(s) And s Like "[А-Яа-яЁё]"
        
        If dic.exists(s) Then s = dic(s)
        n = Len(s): Mid$(sb, j, n) = IIf(caseBool, Chr$(Asc(s) - 32), s)
        
        
        If n > 1 Then j = j + 1
    Next
    txEng.Text = sb
End Sub
 
Private Sub UserForm_Initialize()
    Set txRus = Me.Controls.Add("forms.TextBox.1", "txRus", 1)
    txRus.Move 10, 10, 500
    Set txEng = Me.Controls.Add("forms.TextBox.1", "txEng", 1)
    txEng.Move 10, 30, 500
    txEng.Locked = 1
    Me.Width = txEng.Width + 30
    Me.Height = txEng.Top + txEng.Height + 30
    Set dic = CreateObject("Scripting.Dictionary"): dic.comparemode = 1
    '-------------------------
    rus = Split("а/б/в/г/д/е/ё/ж/з/и/й/к/л/м/н/о/п/р/с/т/у/ф/х/ц/ч/ш/щ/ъ/ы/ь/э/ю/я", "/")
    eng = Split("a/b/v/g/d/e/yo/j/z/i/i`/k/l/m/n/o/p/r/s/t/u/f/h/c/ch/sh/s`/``/y`/`/e`/iu/ia", "/")
    For i = 0 To UBound(rus)
        dic(rus(i)) = eng(i)
    Next
End Sub

Миниатюры
Написание русского слова английскими буквами  
0
Заблокирован
04.05.2015, 09:31
Конечно, символы подмены можно поставить какие будет удобнее ..
я списал их от известного кейлогера производителя Яндекс (который знает всё .. : )) )
кроме того заметьте что и регистр сохраняется ..

Вот еще продвинутее, теперь есть кнопка для того чтобы можно было скопировать полученый
текст

Visual Basic Скопировано
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

Option Explicit
'---------------------------------------------------------------------------------------
' Программа     : Транслитерация русского текста
' Дата и время  : 04 мая 2015  09:34
' Автор         : Night Ranger
'                 Яндекс.Деньги - 410012757639478
'                 [email]Exingsteem@yandex.ru[/email]
'                 [url]https://www.cyberforum.ru/vba/[/url]
' Описание      : Программа для быстрой транслитерации
'                 Необходимо создать форму, скопировать в её модуль этот текст и запустить, всё.. ничего больше делать не надо
'---------------------------------------------------------------------------------------
Dim WithEvents txRus As msforms.TextBox
Dim WithEvents txEng As msforms.TextBox
Dim WithEvents comnd As msforms.CommandButton
 
Dim i&, j&, rus$(), eng$(), dic As Object
 
Private Sub comnd_Click()
 
End Sub
 
Private Sub comnd_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        If Len(txEng.Text) Then
            .SetText txEng.Text
            .PutInClipboard
            comnd.Caption = "Готово !, воспользуйтесь вставкой"
        End If
    End With
End Sub
 
Private Sub comnd_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    comnd.Caption = "Скопировать в буфер обмена"
End Sub
 
Private Sub txRus_Change()
    Dim j&, n&, s$, sb$, caseBool As Boolean
    sb = Space$(Len(txRus) * 2)
    For i = 1 To Len(txRus)
        j = j + 1: s = Mid$(txRus, i, 1)
        caseBool = s = UCase(s) And s Like "[А-Яа-яЁё]"
        If dic.exists(s) Then s = dic(s)
        n = Len(s): Mid$(s, 1, 1) = IIf(caseBool, Chr$(Asc(s) - 32), s)
        Mid$(sb, j, n) = s
        If n > 1 Then j = j + 1
    Next
    txEng.Text = RTrim(sb)
End Sub
 
Private Sub UserForm_Initialize()
    Set txRus = Me.Controls.Add("forms.TextBox.1", "txRus", 1)
    txRus.Move 10, 10, 500
    Set txEng = Me.Controls.Add("forms.TextBox.1", "txEng", 1)
    txEng.Move 10, 30, 500
    txEng.Locked = 1
    Set comnd = Me.Controls.Add("forms.CommandButton.1", "comnd", 1)
    With comnd
        .Move 10, 50, 200, 20
        comnd_MouseUp 0, 0, 0, 0
        Me.Height = .Top + .Height + 30
    End With
    Me.Width = txEng.Width + 30
 
    Set dic = CreateObject("Scripting.Dictionary"): dic.comparemode = 1
    '-------------------------
    rus = Split("а/б/в/г/д/е/ё/ж/з/и/й/к/л/м/н/о/п/р/с/т/у/ф/х/ц/ч/ш/щ/ъ/ы/ь/э/ю/я", "/")
    eng = Split("a/b/v/g/d/e/yo/j/z/i/i`/k/l/m/n/o/p/r/s/t/u/f/h/c/ch/sh/s`/``/y`/`/e`/iu/ia", "/")
    For i = 0 To UBound(rus)
        dic(rus(i)) = eng(i)
    Next
End Sub
1
 Аватар для Sasha_Smirnov
5562 / 1370 / 150
Регистрация: 08.02.2009
Сообщений: 4,109
Записей в блоге: 30
29.12.2016, 16:08
А что, по умолчанию репрессант лишается всех наград или это задокументировано?

Вот картину репрессированного мастера хвалить можно, а почему никак не отметить код Night Ranger’а?

(Зачем? — Заслужил!)
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
 29.12.2016, 16:08
Помогаю со студенческими работами здесь

Заполнение одномерного массива английскими строчными буквами
Помогите пожалуйста разобратся как заполнить этот массив строчными английскими буквами и вывести в поле вывода. Делаю, но вот не получается...

Синий экран с английскими буквами, и комп не функционирует
здрасте! вот купил год назад комп DEPOвский стояла ОС Windows Vista Home Basic потом поставил Home Edition так как XP PRO SP-3 не...

Шифрование, программа работает с английскими буквами, а нужно чтобы работало с русскими
31 буква русского алфавита Ё буквы не должно быть, слово КРИПТОГРАФИЯ const TPolibius: array of char = ( ('A', 'B', 'C', 'D',...

Найти максимальное количество символов между двумя английскими заглавными буквами
Нужна программа на C (не на C++), которая считает, максимальное кол-во символов между 2мя английскими заглавными буквами (ASCII)... ...

Заполнить литерный массив заглавными английскими буквами и подсчитать количество букв
#1 Дан литерный массив 4х5. Заполнить его заглавными английскими буквами и подсчитать количество букв, которые по алфавиту находятся...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Новые блоги и статьи
Результаты исследования от команды MCM (март 2025 г.)
Programma_Boinc 07.04.2025
Результаты исследования от команды MCM (март 2025 г. ) В рамках наших текущих исследований мы продолжаем изучать гены, которые имеют наибольшую вероятность развития рака легких, выявленные в рамках. . .
Рекурсивные типы в Python
py-thonny 07.04.2025
Рекурсивные типы - это типы данных, которые определяются через самих себя или в сочетании с другими типами, которые в свою очередь ссылаются на исходный тип. В мире программирования такие структуры. . .
C++26: Объединение и конкатенация последовательностей и диапазонов в std::ranges
NullReferenced 07.04.2025
Работа с последовательностями данных – одна из фундаментальных задач, с которой сталкивается каждый разработчик. C++ прошел длинный путь в эволюции средств для манипуляции коллекциями – от. . .
Обмен данными в микросервисной архитектуре
ArchitectMsa 06.04.2025
Когда разработчики начинают погружаться в мир микросервисов, они часто сталкиваются с парадоксальным правилом: "два сервиса не должны делить один источник данных". Эта мантра звучит повсюду в. . .
PostgreSQL в Kubernetes: Автоматизация обслуживания с CNPG
Mr. Docker 06.04.2025
Администраторы баз данных сталкиваются с целым рядом проблем при обслуживании PostgreSQL в Kubernetes: как обеспечить правильную репликацию данных, как настроить автоматическое переключение при. . .
Async/await в TypeScript
run.dev 06.04.2025
Асинхронное программирование — это подход к разработке программного обеспечения, при котором операции выполняются независимо друг от друга. В отличие от синхронного выполнения, где каждая последующая. . .
Многопоточность в C#: Синхронизация потоков
UnmanagedCoder 06.04.2025
Многопоточное программирование стало неотъемлемой частью разработки современных приложений на C#. С появлением многоядерных процессоров возможность выполнять несколько задач параллельно значительно. . .
TypeScript: Классы и конструкторы
run.dev 06.04.2025
TypeScript, как статически типизированный язык, построенный на основе JavaScript, привнес в веб-разработку новый уровень надежности и структурированности кода. Одним из важнейших элементов этой. . .
Многопоточное программирование: Rust против C++
golander 06.04.2025
C++ существует уже несколько десятилетий и его поддержка параллелизма постепенно наращивалась со временем. Начиная с C++11, язык получил стандартную библиотеку для работы с потоками, а в последующих. . .
std::vector в C++: от основ к оптимизации производительности
NullReferenced 05.04.2025
Для многих программистов знакомство с std::vector происходит на ранних этапах изучения языка, но между базовым пониманием и подлинным мастерством лежит огромная дистанция. Контейнер std::vector. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2025, CyberForum.ru
Выделить код Копировать код Сохранить код Нормальный размер Увеличенный размер