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

@Костяныч · Регистрация: 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. Спасибо за помощь.

Новые блоги и статьи Все статьи Все блоги /
делаю науч статью по влиянию грибов на сукцессию anaschu 13.03.2026 прикрепляю статью	SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .
Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .	Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .

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

	Словесное представление чисел 11.04.2014, 19:34. Показов 1910. Ответов 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

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

Решение