Dzisiaj dostałem zadanie aby pomóc stworzyć w Excel formułę na zapisywanie kwoty słownie. To przeszukaniu funkcji w Excel stwierdziłem że chyba nie ma czegoś takiego zatem zacząłem szukać no i dostałem coś takiego, że trzeba stworzyć makro. Zatem ALT+F11 i zaczynamy:
Option Compare Binary 'typ porownania stringów: binarny
Option Explicit 'wymusza deklaracje zmiennych
'deklaracja zmiennych
Private Male As Variant
Private Nascie As Variant
Private Duze As Variant
'tworzenie metody
'parametr 'l' kwota z akrusza w formacie Currency
Function Słownie(ByVal l As Currency) As String
'definicja zmiennych
Dim S, temp As String
Dim zl As Currency
Dim g, i, gr, pos, j, koncowka As Integer
Dim rozdziel(0 To 3) As Variant 'zmienna trzyma grupy cyfr: na razie 4: tysiące, miliony, miliardy, biliony
'tworzenie tablic
Male = Array( _
Array("", "jeden", "dwa", "trzy", "cztery", "pięć", "sześć", "siedem", "osiem", "dziewięć"), _
Array("", "", "dwadzieścia", "trzydzieści", "czterdzieści", "pięćdziesiąt", "sześćdziesiąt", "siedemdziesiąt", "osiemdziesiąt", "dziewięćdziesiąt"), _
Array("", "sto", "dwieście", "trzysta", "czterysta", "pięćset", "sześćset", "siedemset", "osiemset", "dziewięćset") _
)
Nascie = Array("dziesięć", "jedenaście", "dwanaście", "trzynaście", "czternaście", "piętnaście", "szesnaście", "siedemnaście", "osiemnaście", "dziewiętnaście")
Duze = Array( _
Array("tysiąc", "tysiące", "tysięcy"), _
Array("milion", "miliony", "milionów"), _
Array("miliard", "miliardy", "miliardów"), _
Array("bilion", "biliony", "bilionów") _
)
l = WorksheetFunction.Ceiling(l, 0.01) 'zaokraglamy do groszy
zl = Fix(l) 'zapisuje czesc całkowitą
gr = (l - zl) * 100 'zapisujemy grosze
S = CStr(zl) 'zmieniamy kwotę na stringa
'inicjalizacja zmiennych potrzebnych do obsługi pętli
i = 0
g = 0
'inicjuj grupę
rozdziel(g) = Array(-1, -1, -1)
For pos = Len(S) - 1 To 0 Step -1
rozdziel(g)(i) = CByte(Mid(S, pos + 1, 1)) 'zapisujemy jeden znak do odpowiedniej pozycji w grupie
'tworzymy nową grupę cyfr
If i = 2 And pos > 0 Then
g = g + 1 'nowy id grupy
i = -1 'przy nastepnej petli i = 0
rozdziel(g) = Array(-1, -1, -1) 'inicjujemy nową grupę
End If
i = i + 1
Next
S = "" 'czyscimy zmienna S ktora będzie "zbierała" kwotę słownie
For i = 0 To g
temp = ""
For j = 2 To 0 Step -1 'poruszamy się po grupie od końca
If rozdziel(i)(j) > -1 Then 'analizujemy tylko wartości różne od -1
If j = 1 Then
If rozdziel(i)(j) = 1 Then 'sprawdzamy czy środkowa cyfra nie jest cyfrą 1 aby wywołać tablicę NASCIE
temp = temp & Nascie(rozdziel(i)(0)) & " "
rozdziel(i)(0) = -1 'czyścimy pierwszą liczbę w grupie bo już nie jest potrzebna
Else:
temp = temp & Male(j)(rozdziel(i)(j)) & " "
End If
Else:
temp = temp & Male(j)(rozdziel(i)(j)) & " "
End If
End If
Next
If rozdziel(i)(2) > -1 Then 'ostatnia cyfra z tysiaca jest zdefiniowana
If i + 1 <= g Then 'jest nastepna grupa cyfr 'ustalamy koncówkę dla tablicy DUZE Select Case CByte(rozdziel(i + 1)(0)) 'analizujemy pierwszą cyfrę w kolejnej grupie Case 1: koncowka = 0 Case 2, 3, 4: koncowka = 1 Case Else: koncowka = 2 End Select If rozdziel(i + 1)(1) = 1 Then 'analizujemy drugą cyfrę w kolejnej grupie koncowka = 2 End If 'jeśli następna grupa nie jest pusta dodaj wartość z tablicy DUZE If rozdziel(i + 1)(0) > 0 Or rozdziel(i + 1)(1) > 0 Or rozdziel(i + 1)(2) > 0 Then
S = Duze(i)(koncowka) & " " & temp & S
Else: S = temp & S
End If
Else: S = temp & S
End If
Else: S = temp & S
End If
Next
Słownie = S & "zł, " & Format(CDbl(gr), "00") & "/100" 'wyświetl liczbę słownie
End Function
I teraz jak wpiszemy w komórkę
=Słownie(2,51)
otrzymamy wynik
dwa zł, 51/100