Словесное представление чисел

@Костяныч · Регистрация: 31.10.2010

Студворк — интернет-сервис помощи студентам

Добрый день,
Есть строка, например "я купил хлеб за 23 рубля, сдача составляет 7 рублей". Подскажите, как выловить цифры из нее и заменить на слова? В итоге должно получиться "я купил хлеб за двадцать три рубля, сдача составляет семь рублей".
Спасибо за помощь.

@Pro_grammer · 11.04.2014, 20:27

Код заготовки

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
 Private Function propis(numb As Long) As String
Select Case numb
Case 23
propis = "двадцать три"
Case 7
propis = "семь"
End Select
 End Function
  
 Private Sub Form_Load()
 Dim arrMyArray() As String
  Dim strMyString As String
  strMyString = "я купил хлеб за 23 рубля, сдача составляет 7 рублей"
  arrMyArray = Split(strMyString)
  
  For i = 0 To UBound(arrMyArray)
    If Val(arrMyArray(i)) Then
    arrMyArray(i) = propis(Val(arrMyArray(i)))
  End If
  strMyString = ""
  Next
   For i = 0 To UBound(arrMyArray)
   strMyString = strMyString & " " & arrMyArray(i)
  Next
  MsgBox strMyString
End Sub

Заготовка потому, что Function propis работает только с этими конкретными цифрами. В Интернетах полно готовых функций на VB6, корыте так и называются "Число прописью". Т.е. им на вход подаешь число, а они его переводят в пропись согласно русской грамматике.

P.S. Конечно можно развить и мою процедуру до рабочего состояния, только в конструкцию Select Case придется записать все возможные числа, что совершенно невозможно

Добавлено через 7 минут
Даже вот тут есть, только убрать вывод валюты -> Готовые решения и полезные коды на Visual Basic 6.0

SoftIce · 11.04.2014, 20:28

Функция отсюда

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
 
Private Sub Command1_Click()
    Dim SS, S As String, i As Integer
    S = InputBox("Ввод", "Ввод", "я купил хлеб за 23 рубля, сдача составляет 7 рублей")
    SS = Split(S)
    For i = 0 To UBound(SS)
        If IsNumeric(SS(i)) Then SS(i) = num2text_word(CLng(SS(i)))
    Next i
    MsgBox Join(SS)
End Sub
 
Function num2text_word(x As Long, Optional Lang As Long = 1049) As String
    With CreateObject("word.document")
       .Range.LanguageID = Lang
       .Fields.Add .Range, Type:=-1, Text:="=" & x & " \* cardtext"
        num2text_word = Replace(.Range.Text, vbCr, "")
       .Close 0
    End With
End Function

@Pro_grammer · 11.04.2014, 20:40

Готовые решения и полезные коды на Visual Basic 6.0

Если нет на компьютере MS Office

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
'
'       Число прописью
'       © JoraVoenyjHaker
'
Const s0 = "ноль"
Const s1 = "один два три четыре пять шесть семь восемь девять"
Const s2 = "одинадцать двенадцать тринадцать четырнадцать пятнадцать шестнадцать семнадцать восемнадцать девятнадцать"
Const s3 = "десять двадцать тридцать сорок пятьдесят шестьдесят семьдесят восемьдесят девяносто"
Const s4 = "сто двести триста четыреста пятьсот шестьсот семьсот восемьсот девятьсот"
Const s5 = "тысяча-тысячи-тысяч/" & _
"миллион/миллиард/триллион/" & _
"квадриллион/квинтиллион/секстиллион/" & _
"септиллион/октиллион/нониллион/" & _
"дециллион/андециллион/дуодециллион/" & _
"тредециллион/кваттордециллион/квиндециллион/" & _
"сексдециллион/септемдециллион/октодециллион" 'Наверное хватит )))
 Enum f_UpNu
    [Начало с заглавной буквы] = 1
    [Расставить запятые] = 2
 End Enum
 
Public Function UppercaseNumber$(ByVal Num$, Optional flag As f_UpNu, Optional Rekurs&)
    'Возвращаемое значение предложение словами от -10^60+1  до 10^60-1
    'Арг: Число текстом "1234..." без других знаков // Комбинируемый флаг // Текущая рекурсия
    Const r$ = "/", r1 = "-", pr$ = " "
    Dim l#, l1#, l2#, key1$, key2$, key3$, j$(), f&
    Dim Sborka$
    
    If Rekurs = 0 Then
        Num = Replace(Num, pr, "") 'Удалить возможные пробелы
        If Num = 0 Then
            UppercaseNumber = s0: Exit Function
        ElseIf Num < 0 Then
            Num = Mid(Num, 2)
            Sborka = "минус "
        End If
    End If
    key1 = Num
    Do
        l = Len(key1)
        Select Case l
        Case 1
            l1 = Mid(key1, 1, 1)
            If l1 > 0 Then Sborka = Sborka & Split(s1)(l1 - 1) & pr
            key1 = Mid(key1, 2)
        Case 2
            If key1 > 10 And key1 < 20 Then
                l1 = Mid(key1, 2, 1)
                Sborka = Sborka & Split(s2)(l1 - 1) & pr
                key1 = Mid(key1, 3)
            Else
                l1 = Mid(key1, 1, 1)
                If l1 > 0 Then Sborka = Sborka & Split(s3)(l1 - 1) & pr
                key1 = Mid(key1, 2)
            End If
        Case 3
            l1 = Mid(key1, 1, 1)
            If l1 > 0 Then Sborka = Sborka & Split(s4)(l1 - 1) & pr
            key1 = Mid(key1, 2)
        Case Is > 3
            Do
                l1 = l Mod 3
                If l1 Then
                    key2 = Mid(key1, 1, l1): key1 = Mid(key1, l1 + 1)
                Else: key2 = Mid(key1, 1, 3): key1 = Mid(key1, 4)
                End If
                key3 = UppercaseNumber(key2, flag, Rekurs + 1)
                l = Len(key1): l2 = Fix(l / 3) - 1
                
                If key3 <> s0 Then
                    Sborka = Sborka & key3
                    If Right$(key2, 2) > 10 And Right$(key2, 2) < 20 Then key2 = 0
                    If l2 = 0 Then
                        j = Split(Split(s5, r)(l2), r1)
                        Select Case key2 Mod 10
                        Case 1: Sborka = Sborka & j(0) & pr
                        Case 2, 3, 4: Sborka = Sborka & j(1) & pr
                        Case Else: Sborka = Sborka & j(2) & pr
                        End Select
                        Sborka = Replace(Sborka, "один тысяча", "одна тысяча")
                        Sborka = Replace(Sborka, "два тысячи", "две тысячи")
                    Else
                        j = Split("0 а ов")
                        j(0) = Split(s5, r)(l2)
                        Select Case key2 Mod 10
                        Case 1: Sborka = Sborka & j(0) & pr
                        Case 2, 3, 4: Sborka = Sborka & j(0) & j(1) & pr
                        Case Else: Sborka = Sborka & j(0) & j(2) & pr
                        End Select
                    End If
                    If flag >= [Расставить запятые] Then Sborka = RTrim(Sborka) & ", "
                End If
            Loop While l > 3
        End Select
    Loop While l
    
    If Rekurs = 0 Then
        Num = flag Mod 4
        While Num
            Select Case Num
            Case Is >= [Расставить запятые]
                Num = Num - [Расставить запятые]
            Case Is >= [Начало с заглавной буквы]
                Num = Num - [Начало с заглавной буквы]
                Mid(Sborka, 1, 1) = UCase(Mid(Sborka, 1, 1))
            End Select
        Wend
    End If
    UppercaseNumber = Sborka
End Function
 
 
 Private Sub Form_Load()
 Dim arrMyArray() As String
  Dim strMyString As String
  strMyString = "я купил хлеб за 24 рубля, сдача составляет 9 рублей"
  arrMyArray = Split(strMyString)
  
  For i = 0 To UBound(arrMyArray)
    If Val(arrMyArray(i)) Then
    arrMyArray(i) = UppercaseNumber$(Val(arrMyArray(i))) '
  End If
  strMyString = ""
  Next
   For i = 0 To UBound(arrMyArray)
   strMyString = strMyString & " " & arrMyArray(i)
  Next
  MsgBox strMyString
End Sub

@Костяныч · 12.04.2014, 07:42 **[ТС]**

Pro_grammer, а что за конструкция на строчках 17-20. Копирую её, указывает на ошибки "bracketed identifier is missing closing ']'"

@Pro_grammer · 12.04.2014, 08:27

Сообщение от Костяныч

конструкция на строчках 17-20.

Обычное перечисление и определение значения его элементов.
У меня работает без ошибок на Vb6.
JoraVoenyjHaker оригинально поступил для наглядности, но можно пожертвовать, заменив на цифры.
Т.о. Функция будет определена так
UppercaseNumber$(ByVal Num$, Optional flag , Optional Rekurs&)
в тексте слова заменить числами
[Начало с заглавной буквы] на 1
[Расставить запятые] на 2

ну и конструкцию на строчках 17-20 удалить.

@Костяныч · 12.04.2014, 09:24 **[ТС]**

Сообщение от Pro_grammer

UppercaseNumber$(ByVal Num$, Optional flag , Optional Rekurs&)

а Optional flag так и оставить? у меня ругается на flag, говорит не ясный параметр.

Добавлено через 2 минуты
работаю в ms visual studio

@Pro_grammer · 12.04.2014, 10:19

Сообщение от Костяныч

Optional flag так и оставить?

Тип надо обозначить!

Visual Basic
1
Optional flag As Integer

@Апострофф · 12.04.2014, 10:23

Сообщение от Костяныч

работаю в ms visual studio

Версию уточните. Если новее 1998 г., то вам другой раздел нужен - https://www.cyberforum.ru/vb-net/

@Костяныч · 12.04.2014, 10:28 **[ТС]**

Не могу найти vb6 на win8, у всех ошибки вылетают. Перейду на .Net. Спасибо за помощь.

Новые блоги и статьи Все статьи Все блоги /
Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Нашел на реддите интересную статью под названием «Кто-нибудь знает, где получить бесплатный компьютер или. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro
Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .

@Костяныч 20 / 20 / 4 Регистрация: 31.10.2010 Сообщений: 1,240 Записей в блоге: 2

	Словесное представление чисел 11.04.2014, 19:34. Показов 1893. Ответов 9 Метки нет (Все метки) Добрый день, Есть строка, например "я купил хлеб за 23 рубля, сдача составляет 7 рублей". Подскажите, как выловить цифры из нее и заменить на слова? В итоге должно получиться "я купил хлеб за двадцать три рубля, сдача составляет семь рублей". Спасибо за помощь. 0

@Костяныч 20 / 20 / 4 Регистрация: 31.10.2010 Сообщений: 1,240 Записей в блоге: 2
	12.04.2014, 07:42 [ТС]
	Pro_grammer, а что за конструкция на строчках 17-20. Копирую её, указывает на ошибки "bracketed identifier is missing closing ']'" 0

@Костяныч 20 / 20 / 4 Регистрация: 31.10.2010 Сообщений: 1,240 Записей в блоге: 2
	12.04.2014, 10:28 [ТС]
	Не могу найти vb6 на win8, у всех ошибки вылетают. Перейду на .Net. Спасибо за помощь. 0

Словесное представление чисел

Решение