Částka slovně

Úvodní stránka | Blog | Excel VBA | Čá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í:
    excel-castka-slovne.zip

    Uložit článek jako PDF