Сумма прописью

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

Немного теории

Любая сумма имеет целую часть (рубли) и, иногда, дробную (копейки). С копейками все понятно - они обычно пишутся цифрами. С рублями все несколько сложнее. Самая большая загвоздка - это разрядность. Хотя, если подумать, то не такая уж это и проблема. Весь алгоритм несколько похож на алгоритм склонения ФИО по падежам, а именно - подставить нужное окончание. Разница лишь в том, что имена не все предсказуемы, а с числами все проще.

Функция разбиения на разряды

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

Public Function IntToWords(s)
    Dim i, count
 
 ' если длина строки 0 или значение 0
    If (Len(s) = 0) Or (s = "0") Then
        IntToWords = "ноль"
        Exit Function
    End If
 
 ' определим количество разрядов
    count = (Len(s) + 2) \ 3
 
 ' если количество разрядов больше 7, тогда говорим, что не можем прописать словами
    If count > 7 Then
        IntToWords = "Value is too large"
        Exit Function
    End If
 
    result = ""
    s = "00" + s
 
 ' поразрядно переводим число в слова
    For i = 1 To count
        result = ShortNum((Mid(s, Len(s) - 3 * i + 1, 3)), i - 1) + result
    Next
 
    If Len(result) > 0 Then
        result = Right(result, Len(result) - 1)
    End If
 
    IntToWords = result
End Function

Самое интересное - функция ShortNum. Именно она пишет числа прописью.

Число прописью

Public Function ShortNum(num, razr)
 
 Dim hundreds, tens, ones, razryad
 
 ' сотни
 hundreds = Array("", " сто", " двести", " триста", " четыреста", " пятьсот", " шестьсот", " семсот", " восемьсот", " девятьсот")
 
 ' десятки
 tens = Array("", "", " двадцать", " тридцать", " сорок", " пятьдесят", " шестьдесят", " семьдесят", " восемьдесят", " девяносто")
 
 ' единицы
 ones = Array("", "", "", " три", " четыре", " пять", " шесть", " семь", " восемь", " девять", " десять", " одиннадцать", " двенадцать", " тринадцать", " четырнадцать", " пятнадцать", " шестнадцать", " семнадцать", " восемнадцать", " девятнадцать")
 
 ' разряды
 razryad = Array("", " тысяч", " миллион", " миллиард", " триллион", " квадриллион", " квинтиллион")
 
 Dim t, o 'десятки 'единицы
 
 result = hundreds(num \ 100)
 
 ' если число 0, тогда ничего делать не нужно
 If num = 0 Then Exit Function
 
 ' определим десятки
    t = (num Mod 100) \ 10
 
 ' определим единицы
    o = num Mod 10
 
 ' подставим число прописью и добавим соответствующее окончание
    If t <> 1 Then
        result = result + tens(t)
        Select Case o
            Case 1
                If razr = 1 Then
                    result = result + " одна"
                Else
                    result = result + " один"
                End If
            Case 2
                If razr = 1 Then
                    result = result + " две"
                Else
                    result = result + " два"
                End If
            Case 3, 4, 5, 6, 7, 8, 9
                result = result + ones(o)
        End Select
 
        result = result + razryad(razr)
 
        Select Case o
            Case 1
                If razr = 1 Then
                    result = result + "а"
                End If
            Case 2, 3, 4
                If razr = 1 Then
                    result = result + "и"
                Else
                    If (razr > 1) Then
                        result = result + "а"
                    End If
                End If
            Case 5, 6, 7, 8, 9, 0
                If (razr > 1) Then
                    result = result + "ов"
                End If
        End Select
 
 Else
  result = result + ones(num Mod 100)
  result = result + razryad(razr)
 
  If razr > 1 Then
   result = result + "ов"
  End If
 End If
 
 ShortNum = result
 
End Function

Функция для формулы

Для наглядного примера можно использовать формулу. Для этого создадим функцию, которую потом вставим в формулу

Public Function sum_in_words(s)
    Dim units As String ' рубли
    Dim subunits As Long ' копейки
    Dim unit_string As String ' рубли прописью
 
 ' если пусто, тогда ничего делать не будем
    If s = "" Then
        sum_in_words = ""
        Exit Function
    End If
 
 ' выделим рубли из числа
    units = Int(s)
 
 ' выделим копейки из числа
    subunits = Round(Abs(s) - Abs(units), 2) * 100
 
 ' переведем число рублей в слова
    unit_string = IntToWords(units) & " руб."
 
 ' припишем копейки.
 ' копейки обычно пишутся числом, соответственно, 
 ' нам нужно добавить 0 перед копейками, если их меньше 10
    If subunits < 10 Then
        sum_in_words = unit_string & " 0" & subunits & " коп."
    Else
        sum_in_words = unit_string & " " & subunits & " коп."
    End If
End Function

И, собственно, формула:
=quantity_in_words(A1)