Částka slovně

Je to už 12 let, co jsem si poprvé zkusil vytvořit funkci, která by zvládla převod celé částky na slovní vyjádření. A ačkoliv jsem si před dvěma roky a několika opravách myslel, že je kód již v pořádku, včera mě pan Vratislav Janko upozornil na chybu pro “dvě miliardy”. Opraveno. Děkuji.

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
Option Base 1

Function epfCISLOSLOVNE(Cislo As Double, Optional Velke As Boolean = True) As _
    String

    Dim aJednotky
    Dim aDesitky
    Dim aStovky
    Dim aRady
    Dim aRady1
    Dim aRady234

    Dim i As Integer
    Dim iPocet3 As Integer
    Dim iDelka As Integer
    Dim iDelka3 As Integer
    Dim iStovky As Integer
    Dim iDesitkyJednotky As Integer

    Dim strCislo3 As String
    Dim strStovky As String
    Dim strDesitkyJednotky As String
    Dim strCisloText As String

    'vynucený přepočet funkce při změně na listu
    Application.Volatile

    'pole pro desítky
    aDesitky = Array("", "deset", "dvacet", "třicet", "čtyřicet", "padesát", _
        "šedesát", "sedmdesát", "osmdesát", "devadesát")

    'pole pro jednotky
    aJednotky = Array("", "jedna", "dva", "tři", "čtyři", "pět", "šest", "sedm", _
        "osm", "devět", "deset", "jedenáct", "dvanáct", "třináct", "čtrnáct", _
        "patnáct", "šestnáct", "sedmnáct", "osmnáct", "devatenáct")

    'pole pro stovky
    aStovky = Array("", "sto", "dvěstě", "třista", "čtyřista", "pětset", _
        "šestset", "sedmset", "osmset", "devětset")

    'pole pro řády
    aRady = Array("", "tisíc", "milionů", "miliard")
    aRady1 = Array("", "tisíc", "milion", "miliarda")
    aRady234 = Array("", "tisíce", "miliony", "miliardy")

    'skutečná délka čísla
    iDelka = Len(CStr(Cislo))
    'délka čísla po zaokrouhlení na trojice nahoru
    iDelka3 = WorksheetFunction.Ceiling(iDelka, 3)
    'číslo formátované do trojic
    strCislo3 = Format(Cislo, String(iDelka3, "0"))
    'počet trojic
    iPocet3 = iDelka3 \ 3

    'pro všechny trojice
    For i = 1 To iPocet3

        'reset proměnných
        strStovky = ""
        strDesitkyJednotky = ""
        strRady = ""

        'počet stovek
        iStovky = Val(Mid(strCislo3, 3 * i - 2, 1))
        'počet desítek a jednotek
        iDesitkyJednotky = Val(Mid(strCislo3, 3 * i - 1, 2))

        'a) bez ošetření "jednosto"
        'strStovky = aStovky(iStovky + 1)

        'b) s ošetřením "jednosto"
        'If iStovky = 1 And i = 1 Then
        If iStovky = 1 Then
            strStovky = "jedno" & aStovky(iStovky + 1)
        Else
            strStovky = aStovky(iStovky + 1)
        End If

        'rozlišení desítek a jednotek
        Select Case iDesitkyJednotky
            Case 0
                If iStovky = 0 Then
                    If iPocet3 = 1 Then
                        strDesitkyJednotky = "nula"
                    End If
                Else
                    'text tisíců, milionů, ...
                    strRady = aRady(iPocet3 - i + 1)
                End If
            Case 1
                'výjimka, "jeden" namísto "jedna" z pole
                'pro "jedentisíc", "jedenmilion", ...
                If (iStovky = 0) And (iPocet3 > 1) And (i <> iPocet3) Then
                    'text desítek a jednotek
                    strDesitkyJednotky = "jeden"
                Else
                    'text desítek a jednotek
                    strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                End If
                'text tisíců, milionů, ...
                strRady = aRady1(iPocet3 - i + 1)
            Case 2
                'výjimka, "dvě" namísto "dva" z pole
                'pro "dvě" (koruny, miliardy)
                If (iStovky = 0 And iPocet3 = 1) Or (iStovky = 0 And iPocet3 = _
                    4) Then
                    'text desítek a jednotek
                    strDesitkyJednotky = "dvě"
                Else
                    'text desítek a jednotek
                    strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                End If
                'text tisíců, milionů, ...
                strRady = aRady234(iPocet3 - i + 1)
            Case 3, 4
                strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                'text tisíců, milionů, ...
                strRady = aRady234(iPocet3 - i + 1)
            Case 5 To 19
                'text desítek a jednotek
                strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                'text tisíců, milionů, ...
                strRady = aRady(iPocet3 - i + 1)
            Case Is >= 20
                'text desítek a jednotek
                strDesitkyJednotky = aDesitky((iDesitkyJednotky \ 10) + 1) & _
                    aJednotky((iDesitkyJednotky Mod 10) + 1)
                'text tisíců, milionů, ...
                strRady = aRady(iPocet3 - i + 1)
        End Select

        strCisloText = strCisloText & strStovky & strDesitkyJednotky & strRady

    Next i

    epfCISLOSLOVNE = IIf(Velke, UCase(Left$(strCisloText, 1)) & _
        Mid$(strCisloText, 2), strCisloText)

End Function

Aplikovanou funkci ukazuje obrázek.

Excel - částka slovně

Excel – částka slovně

A jak to šlape? Největším problémem všeho je pochopitelně čeština a skloňování číslovek. Při tvorbě funkce jsem vycházel z následujícího:

  1. jedna (koruna), jedno sto, jeden tisíc
  2. dvě (koruny), dva tisíce
  3. skloňování tisíců, milionů, miliard, … {1}, {2,3,4}, {5, 6, 7, 8, …}, viz pole aRady, aRady1, aRady234
  4. čísla 1..19 mají specifickou slovotvorbu (nestačí přidat “náct”, např. “čtyři/čtrnáct”), viz pole aJednotky
  5. desítky 20..90 mají také specifickou slovotvorbu (nestačí přidat “cet”, např. “pět/padesát”), viz pole aDesitky
  6. základními bloky (B), se kterými bude algoritmus pracovat, budou trojčíslí
  7. jestliže počet cifer částky neodpovídá násobku 3 (tj. celým počtům trojciferných bloků, viz celočíselné dělení a operátor Mod ve funkci), bude na tento násobek částka doplněna úvodními nulami (viz funkce listu Celing, tj. ZAOKR.NAHORU a Format).
  8. každý blok (B) bude rozebrán na stovky (B1) a desítky s jednotkami (B2), např. pro číslo 123 je B1 = 1 a B2 = 23.
  9. od počtu bloků se bude odvíjet slovní vyjádření tisíců, milionů, …

Parametr “Velke” je ve výchozím stavu nastaven na True, což odpovídá pravidlu České pošty “Údaj ve slovech začíná velkým písmenem a píše se jedním slovem.” – viz Poštovní poukázka A (náhled na vyplněnou poukázku).

Částka “sto…” je doplněna na “jednosto…”, podobně jako je “jedentisíc…”

Formátování buněk chránící částku proti doplnění:
B46: *=0
C46: @*=

Nutno podotknout, že v případě formátování nebude buňka chráněna stoprocentně a záleží na šířce buňky. Běžné fonty (Calibri, Arial) neobsahují symbol dvojité spojité čáry (při opakování na sebe symboly navazují), namísto toho je použit znak “=” (malá mezírka na obou stranách), který odpovídá šířce běžného znaku. Proto, pokud se před číslo nevejde celý znak, vznikne před ním nepatrný prostor. Ideální by byl symbol “spojité dvojtečky”.

Peněžní částky, značky měn
Počítaný předmět po číslovkách
Členění čísel, víceslovné číslovkové výrazy (typ 365, 2 582) a desetinná čísla

Odkaz ke stažení:
[download id=”814″]

Klikni a stahuj!