Chyba każdy program księgowy ma taką funkcjonalności, że potrafi zamienić liczbową reprezentację kwoty na jej reprezentację słowną, czyli przykładowo:
123, 45zł -> sto dwadzieścia trzy złote i czterdzieści pięć groszy
Jak to zrobić w Excelu? Potrzeba odpowiedni kod. Niestety nie jest znany mi jego autor, bo na żadnej stronie, gdzie go widziałem nikt nie wiedział kto go napisał. Mi on się bardzo podoba, bo jak się go odpowiednio podzieli jest naprawdę prosty do zrozumienia.
Ja żeby lepiej go zrozumieć dołożyłem do niego jeszcze część odpowiedzialną za przekształcenie miliardów.
Kod składa się z dwóch funkcji, które z komentarzami zamieszczam poniżej:
Function Słownie(x As Variant) As String 'dla liczb od -999 999 999 999.99 do 999 999 999 999.99
'Sprawdzamy czy podana kwota jest mniejsza od zera jeśli jest to dopisujemy do kwoty słownie słowo minus
If x < 0 Then w = w & "minus "
'Konwertujemy liczbę na zapis, który będzie pokazywał zawsze miliardy miliony, tysiące i jednostki
'nawet jeśli będą to same zera
x = Format(Abs(x), "000 000 000 000.00")
'części odpowiedzialne za miliardy, miliony itd. przypisujemy do oddzielnych zmiennych 3 cyfrowych
'wiodące zera również są w nich brane pod uwagę, a do groszy musimy dodać jedna zero na początku
'żeby później działało odpowiednio z funckją trzy
mld = Left(x, 3): m = Mid(x, 5, 3): t = Mid(x, 9, 3): j = Mid(x, 13, 3): g = "0" & Right(x, 2)
'Sprawdzamy miliardy i w zależności od ich ilości nadajemy inne końcówki
'analogicznie robimy z milionami, tysiącami, jednościami i groszami
Select Case mld
Case 0
Case 1
w = "jeden miliard "
Case Else
'za pomocą funkcji trzy sprawdzamy jaka jest liczba miliardów, a późniejszych częściach milionów itd.
w = w & trzy(mld)
'dodajemy odpowiedni "końcówek" na podstawie połączeniu odpowiednich warunków
If Mid(mld, 2, 1) <> 1 And (Right(mld, 1) = 2 Or Right(mld, 1) = 3 Or Right(mld, 1) = 4) Then w = w & "miliardy " Else w = w & "miliardów "
End Select
'Sprawdzanie milionów analogicznie jak miliardów
Select Case m
Case 0
Case 1
w = "jeden milion "
Case Else
w = w & trzy(m)
If Mid(m, 2, 1) <> 1 And (Right(m, 1) = 2 Or Right(m, 1) = 3 Or Right(m, 1) = 4) Then w = w & "miliony " Else w = w & "milionów "
End Select
'Sprawdzanie tysięcy analogicznie jak miliardów
Select Case t
Case 0
Case 1
w = w & "jeden tysiąc "
Case Else
w = w & trzy(t)
If Mid(t, 2, 1) <> 1 And (Right(t, 1) = 2 Or Right(t, 1) = 3 Or Right(t, 1) = 4) Then w = w & "tysiące " Else w = w & "tysięcy "
End Select
'Sprawdzanie jedności analogicznie jak miliardów
Select Case j
Case 0
If mld = 0 And m = 0 And t = 0 Then w = w & "zero złotych " Else w = w & "złotych "
Case 1
If mld = 0 And m = 0 And t = 0 Then w = w & "jeden złoty " Else w = w & "jeden złotych "
Case Else
w = w & trzy(j)
If Mid(j, 2, 1) <> 1 And (Right(j, 1) = 2 Or Right(j, 1) = 3 Or Right(j, 1) = 4) Then w = w & "złote " Else w = w & "złotych "
End Select
'sprawdzanie groszy analogicznie jak miliardów
Select Case g
Case 0
w = w '& "zero groszy"
Case 1
w = w & "jeden grosz"
Case Else
w = w & trzy(g)
If Mid(g, 2, 1) <> 1 And (Right(g, 1) = 2 Or Right(g, 1) = 3 Or Right(g, 1) = 4) Then w = w & "grosze" Else w = w & "groszy"
End Select
Słownie = w
End Function
Function trzy(x As Variant) As String
'dzielimy trzy cyfry na część odpowiedzialną za setki, dziesiątki i jedności
x3 = Val(Left(x, 1)): x2 = Val(Mid(x, 2, 1)): x1 = Val(Right(x, 1))
'Spradzamy jaka to setka
If x3 = 9 Then w = w & "dziewięćset "
If x3 = 8 Then w = w & "osiemset "
If x3 = 7 Then w = w & "siedemset "
If x3 = 6 Then w = w & "sześćset "
If x3 = 5 Then w = w & "pięćset "
If x3 = 4 Then w = w & "czterysta "
If x3 = 3 Then w = w & "trzysta "
If x3 = 2 Then w = w & "dwieście "
If x3 = 1 Then w = w & "sto "
'Sprawdzamy jaka to dziesiątka łącząc z ewentualną setką
If x2 = 9 Then w = w & "dziewięćdziesiąt "
If x2 = 8 Then w = w & "osiemdziesiąt "
If x2 = 7 Then w = w & "siedemdziesiąt "
If x2 = 6 Then w = w & "sześćdziesiąt "
If x2 = 5 Then w = w & "pięćdziesiąt "
If x2 = 4 Then w = w & "czterdzieści "
If x2 = 3 Then w = w & "trzydzieści "
If x2 = 2 Then w = w & "dwadzieścia "
'Sprawdzamy czy to nie jest nastka łącząc z ewentualną setką
If x2 = 1 Then
If x1 = 9 Then w = w & "dziewiętnaście "
If x1 = 8 Then w = w & "osiemnaście "
If x1 = 7 Then w = w & "siedemnaście "
If x1 = 6 Then w = w & "szesnaście "
If x1 = 5 Then w = w & "piętnaście "
If x1 = 4 Then w = w & "czternaście "
If x1 = 3 Then w = w & "trzynaście "
If x1 = 2 Then w = w & "dwanaście "
If x1 = 1 Then w = w & "jedenaście "
If x1 = 0 Then w = w & "dziesięć "
End If
'Sprawdzamy jaka to cyfra jedności i dołączamy do ewentualnej wcześniejszej części
If x2 <> 1 Then
If x1 = 9 Then w = w & "dziewięć "
If x1 = 8 Then w = w & "osiem "
If x1 = 7 Then w = w & "siedem "
If x1 = 6 Then w = w & "sześć "
If x1 = 5 Then w = w & "pięć "
If x1 = 4 Then w = w & "cztery "
If x1 = 3 Then w = w & "trzy "
If x1 = 2 Then w = w & "dwa "
If x1 = 1 Then w = w & "jeden "
End If
trzy = w
End Function
Pozdrawiam
Adam Kopeć
Miłośnik Excela
Microsoft MVP
Jak wklejam ten kod do makr w excelu, to makro nie działa, a Excel w formułach go nie widzi. Jak mam zrobić to popranie ? Pozdrawiam. Paulina
Nie potrafię Ci nic więcej powiedzieć, że ten kod powinnaś skopiować do modułu VBA podpiętego pod konkretny projekt (plik).
Jeśli kod zaczyna się od
Function Słownie(x As Variant)…
a kończy na
trzy = w
End Function
To skopiowałaś cały i nie wiem co poszło nie tak, bo nawet zapisanie pliku nie powinno być potrzebne, żeby funkcja zaczęła być dostępna.
Dzięki za ten materiał.
Po przekopiowaniu tego kodu następuje konwersja znaków cudzysłów i akapitów i kod jest niepoprawny. Proponuję zrobić przycisk "download" kodu w TXT. A lda Pauliny — zrób "replace" znaków “ oraz ” na ", a także ‘ na '
Jeśli klikniesz na kod dwukrotnie to wejdziesz do edycji "tekstowej" i możesz skopiować go bez błędnych cudzysłowów.
Dodatkowo kod strony powoduje, że jak najedziesz na kod myszką, to na jego górze pojawia się menu, gdzie między innymi jest opcja kopiuj.
Znalazłem też dziwną opcję WordPressa, która zmieniała 'zwykłe' cudzysłowy na te powiedzmy 'wordowskie', więc nawet kopiując przez zaznaczanie wszystko powinno pójść dobrze 😉
Czesc. udało mi się dojść jak to zrobić żeby działało. zrobiłem moduł i wkleiłem te 2 funkcje. problem jaki mam to to ze po zamknięciu mam dostępną tylko funkcję trzy a funkcja słownie nie jest już dostępna. używam excel 2016 prosze o pomoc 🙂
Nie mam pomysłu dlaczego po tym jak wkleiłeś funkcje do modułu pliku i działały Ci obie, to po ponownym otwarciu działa Ci tylko jedna 🙁
U mnie (też excel 2016) jest podobnie — wstawiam moduł w edytorze VBA, wklejam kod — wszystko działa. Zapisuję arkusz (jako .xlsm, bo tak mnie excel prosi) i po ponownym otwarciu zarówno funkcja 'słownie', ale też funkcja 'trzy' generuje tylko komunikat '#NAZWA?' i nic nie pomaga :/
Sprawdź czy pozwalasz na działanie makr przy uruchamianiu.
Dodatkowo karta Deweloper -> Bezpieczeństwo makr
Gdy używam tego makra na polskiej wersji exela — jest wszytko ok.
Niestety, gdy chce go użyć na wersji anglojęzycznej pojawiają się robaczki w miejscu polskich znaków (mimo ustawienia systemowego regionu na polski). Pojawia się tylko literka "ó". Zmieniłam w kodzie nazwy jednostek tak by znaków polskich nie było — ale może da się to jakoś "od środka" zrobić ?
Niestety nie znam rozwiązania tego problemu.
Różne języki/znaki zawsze były problematyczne w VBA.
Wszystko super, ale czy wskazujemy jaką komórkę ma zamieniać na tekst i w którą komórkę ma ten teks wpisać?
Przecież to jest zbudowana funkcja, czyli w wstawiasz ją w tej komórce, w której chcesz uzyskać wynik, a w funkcji wskazujesz komórkę jaką masz przekształcić.
W porządku, wczoraj jeszcze trochę poczytałem. Czy ta funkcja będzie działała na ms office 2000? Wyskakuje mi okienko z błędem.
Poradziłem sobie z tym tematem.
Mam jeszcze problem z wyznaczeniem daty. Chodzi o dodawanie dni do dat ale jeżeli data wystąpi w weekend to żeby przeszło na poniedziałek lub kolejny dzień roboczy.
Standardowo to DZIEŃ.ROBOCZY, ale to od Excela 2007 na pewno jest, a nie wiem czy jest w 2000 🙁
Mam pewien problem, nie działa poprawnie gdy wpisuję kwotę w przedziale od 2000 zł do 9999 zł. Przykładowo po wpisaniu 2000,10 pojawia się "tysięcy złotych dziesięć groszy".
Nie wiem czemu WordPress w ostatnim teście sprawdzającym zamienił
na
To powodowało błąd.
Po prostu nie pozwala mi wpisać tych znaków większe niż > i mniejsze niż w komentarzu bo one otwierają znaczniki html ale w kodzie strony udało mi się to poprawić.
Bardzo dziękuję, teraz funkcja działa poprawnie.
Potwierdzam informacje przekazana przez Pana Piotra, dodam iż problem ten występuje przy wszystkich jednościach dla tysięcy, podejrzewam że również dla milionów i miliardów. Widać iż wynika to z kodu, brak części dotyczącej jednostek.
Oto rozwiązanie powyższego problemu.
Na końcu pod wszystkim co przekazał Pan Adam, ale przed
End If
trzy = w
End Function
należy wkleić:
End If
If x2 = 0 Then
If x1 = 9 Then w = w & "dziewięć "
If x1 = 8 Then w = w & "osiem "
If x1 = 7 Then w = w & "siedem "
If x1 = 6 Then w = w & "sześć "
If x1 = 5 Then w = w & "pięć "
If x1 = 4 Then w = w & "cztery "
If x1 = 3 Then w = w & "trzy "
If x1 = 2 Then w = w & "dwa "
If x1 = 1 Then w = w & "jeden "
Cześć,
Jeśli ktoś ma problemy z dostępnością powyższej funkcji w excelu — musicie stworzyć moduł a przed funkcją dodać słówko Public
Pozdrawiam 😉
Super kod
Cieszy mnie, że kod się podaba 😀
Witam,
U mnie Excel 2019 nie widzi tych funkcji, w zależności od tego jak kombinuję z zainstalowaniem tego, czasem widzi funkcję trzy(). Wgrywam cały kod do jednego modułu w PERSONAL.XLBS i nie działa.