Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - 22. Kwoty słownie

Developmax · Excel Expert Posty: 244

Przykład nie jest mojego autorstwa, ale dostępny w internecie. Swego czasu pisałem taką funkcję pod VB (na potrzeby Excela musiałbym ją nieco zmodyfikować).

Generalnie tego typu funkcje można pisać na różne sposoby, a polega to na odpowiednim wyciąganiu słów znaczących przy pomocy takich poleceń wbudowanych w VBA, jak: right, left czy mid.

Pzdr

Slownie.zip

Pobierz Plik ściągnięto 6376 raz(y) 10.56 KB

cerber1 · Excel Expert Posty: 145

Jeśli ktoś ma awersję do kodu VBA, lub chce zobaczyć jak można to samo zrobić używając bardziej "ludzkiego" języka :-D

niech zobaczy poniższy plik.
Dodatkowo jest tu możliwość różnego formatowania kwoty wyrażanej w słowach.

(Nie jestem autorem tego pliku, został znaleziony w necie . Nie znam też autora)

Słownie_bez_VBA.zip

Pobierz Plik ściągnięto 7639 raz(y) 19.19 KB

Misza12 · świeżak Posty: 2

Kiedyś znalazłem takie coś w necie, wystarczy tylko to skopiować w folder AddIns a następnie wejść w dodatki i odchaczyć :-)

U mnie to działa.

slownie.rar
dodatek

Pobierz Plik ściągnięto 4097 raz(y) 17.2 KB

krzysztof_ml · Starszy Forumowicz Posty: 57

Misza12
Jak zastosować Twoją "kwota słownie" w Excelu 2007?

[ Dodano: 2007-07-16, 13:46 ]
cerber1, Prosiłbym, abyś napisał "krok po kroku" jak zastosować Twoją "kwota słownie bez VBA". Próbuję, ale nie udaje mi się

cerber1 · Excel Expert Posty: 145

plitfyg · Excel Expert Posty: 107

Cześć,

Chciałem dodać kolejne (tym razem moje) rozwiązanie z serii "kwoty słownie bez VBA".
Plik w załączniku.

Marcin

excelblog.pl_kwoty_slownie.zip

Pobierz Plik ściągnięto 5253 raz(y) 12.59 KB

krzysztof_ml · Starszy Forumowicz Posty: 57

piotrh21 · świeżak Posty: 1

Witam wszystkich,

może zainteresują kogoś 2 wersje pliku podanego przez Developmax tzn. Kwoty słownie pod VBA, lecz trochę poprawione, bez zbędnych spacji i z różnymi końcówkami krótkich lub pełnych złotych i groszy. Może to będzie w części odpowiedź na sugestię krzysztof_ml.

Pozdrawiam :-)

KwotySlownie.rar

Pobierz Plik ściągnięto 2044 raz(y) 23.79 KB

yesosenk · świeżak Posty: 1

Witam,
właśnie dołączyłem do czytelników forum. Musze przyznać że zaskoczyło mnie swoim wysokim poziomem.
Na początek wrzucę moją wersję makra przetwarzającej liczbę na słownie w wersji walutowej lub nie.
W komórce w której chcemy otrzymać wynik wpisujemy
=Słownie(PRAWDA;A1)
gdzie
pierwszy parametr określa czy podana wartość to waluta czy nie
A1 to komórka zawierająca wartość do konwersji.
Funkcję napisałem w 2001 roku więc pewnie teraz bym w niej co nie co poprawił - ale skoro działa to mi się nie chce :)
Jest za to chyba najkrótszą funkcją jaką do tej pory spotkałem i działa bez zarzutu.

Kod:

Function Słownie(CzyWaluta As Boolean, Liczba As Variant) As Variant
'***********************************************************
' Makro do przeliczania liczby na słownie
' (c) 2001 by Bartłomiej Sosenko
'***********************************************************

Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostek
Grosze = ""
If InStr(1, Liczba, ",", 1) > 0 Then
Grosze = Right(Liczba, Len(Liczba) - InStr(1, Liczba, ",", 1))
If Len(Grosze) = 1 Then Grosze = Grosze & "0"
If Len(Grosze) > 2 Then Grosze = Left(Grosze, 2)
Liczba = Left(Liczba, InStr(1, Liczba, ",", 1) - 1)
End If
Jednostki = Array("", "jeden", "dwa", "trzy", "cztery", _
"pięć", "sześć", "siedem", "osiem", "dziewięć", _
"dziesięć", "jedenaście", "dwanaście", "trzynaście", _
"czternaście", "piętnaście", "szesnaście", "siedemnaście", _
"osiemnaście", "dziewiętnaście")
Dziesiatki = Array("", "dziesięć", "dwadzieścia", "trzydzieści", "czterdzieści", _
"pięćdziesiąt", "sześćdziesiąt", "siedemdziesiąt", _
"osiemdziesiąt", "dziewięćdziesiąt")
Setki = Array("", "sto", "dwieście", "trzysta", "czterysta", "pięćset", "sześćset", _
"siedemset", "osiemset", "dziewięćset")
Slowo = ""
For Gr = 1 To 2
If Len(Liczba) - (Len(Liczba) \ 3) * 3 = 2 Then Liczba = "0" & Liczba
If Len(Liczba) - (Len(Liczba) \ 3) * 3 = 1 Then Liczba = "00" & Liczba
For i = 1 To (Len(Liczba) + 2) \ 3
SlowoP = ""
If i > 1 Then
LiczbaP = Mid(Liczba, Len(Liczba) - (i * 3) + 1, 3)
Else
LiczbaP = Liczba
End If
If Right(LiczbaP, 2) < 20 Then
SlowoP = Jednostki(Right(LiczbaP, 2)) & " " & SlowoP
Else
Slowo2 = Dziesiatki(Left(Right(LiczbaP, 2), 1))
Slowo2 = Slowo2 & " " & Jednostki(Right(LiczbaP, 1))
SlowoP = Slowo2 & " " & SlowoP
End If
If LiczbaP > 99 Then
SlowoP = Setki(Left(Right(LiczbaP, 3), 1)) & " " & SlowoP
End If
Select Case i
Case 1:
If CzyWaluta Then
If (Gr = 2) Then
Przyrostki = Array("grosz", "grosze", "groszy")
Else
Przyrostki = Array("złoty ", "złote ", "złotych ")
End If
Else
If (Gr = 2) Then
Przyrostki = Array("setna", "setne", "setnych")
Else
Przyrostki = Array("", "", "")
End If
End If
Case 2: Przyrostki = Array("tysiąc ", "tysiące ", "tysięcy ")
Case 3: Przyrostki = Array("milion ", "miliony ", "milionów ")
Case 4: Przyrostki = Array("miliard ", "miliardy ", "miliardów ")
Case 5: Przyrostki = Array("bilion ", "biliony ", "bilionów ")
End Select
If ((LiczbaP <> 0) And i > 1) Or (Gr > 0) Then
If LiczbaP <> 0 Then
If LiczbaP = 1 Then
Przyrostek = Przyrostki(0)
Else
If ((Right(LiczbaP, 1) > 1) And (Right(LiczbaP, 1) < 5)) Or _
((Right(LiczbaP, 2) > 21) And (Right(LiczbaP, 1) > 1) And _
(Right(LiczbaP, 1) < 5)) Then Przyrostek = Przyrostki(1)
If ((Right(LiczbaP, 2) > 4) And (Right(LiczbaP, 2) < 22)) Or _
((Right(LiczbaP, 2) > 21) And (Right(LiczbaP, 1) > 4) And _
(Right(LiczbaP, 1) < 22)) Or (Right(LiczbaP, 1) = 0) Or _
(Right(LiczbaP, 1) = 1) Then Przyrostek = Przyrostki(2)
End If
If Gr = 1 Then
Slowo = SlowoP & Przyrostek & Slowo
Else
Slowo = Slowo & SlowoP & Przyrostek
End If
End If
End If
Next i
If Grosze = "" Then
Exit For
Else
If Liczba > 0 Then If Gr = 1 Then Slowo = Slowo & "i "
Liczba = Grosze
End If
Next Gr
If Liczba = 0 Then Slowo = "zero" & Slowo
Słownie = Slowo
End Function

Piotr_Korbicz · Excel Expert Posty: 534

Drobna przeróbkam jeśli można (bo funkcja faktycznie jest krótka więc ją sobie upatrzyłem ;-)

) umożliwiająca zamianę na tekst również liczb ujemnych (jest takie zapotrzebowanie ze strony Forumowiczów).
Dodatkowo zmieniłem kolejność argumentów (pierwsza jest liczba), drugi argument jest opcjonalny (można pominąć - domyślnie tekst jest walutowy)

Kod:

Function Słownie(Liczba As Variant, Optional CzyWaluta) As Variant
'***********************************************************
' Makro do przeliczania liczby na słownie
' (c) 2001 by Bartłomiej Sosenko
'***********************************************************

Dim LiczbaP, Wynik, Slowo, SlowoP, Slowo2, i, Przyrostek

If IsMissing(CzyWaluta) Then CzyWaluta = True

If Liczba < 0 Then
Liczba = -Liczba
przedrostek = "minus "
End If

Grosze = ""
If InStr(1, Liczba, ",", 1) > 0 Then
Grosze = Right(Liczba, Len(Liczba) - InStr(1, Liczba, ",", 1))
If Len(Grosze) = 1 Then Grosze = Grosze & "0"
If Len(Grosze) > 2 Then Grosze = Left(Grosze, 2)
Liczba = Left(Liczba, InStr(1, Liczba, ",", 1) - 1)
End If
Jednostki = Array("", "jeden", "dwa", "trzy", "cztery", _
"pięć", "sześć", "siedem", "osiem", "dziewięć", _
"dziesięć", "jedenaście", "dwanaście", "trzynaście", _
"czternaście", "piętnaście", "szesnaście", "siedemnaście", _
"osiemnaście", "dziewiętnaście")
Dziesiatki = Array("", "dziesięć", "dwadzieścia", "trzydzieści", "czterdzieści", _
"pięćdziesiąt", "sześćdziesiąt", "siedemdziesiąt", _
"osiemdziesiąt", "dziewięćdziesiąt")
Setki = Array("", "sto", "dwieście", "trzysta", "czterysta", "pięćset", "sześćset", _
"siedemset", "osiemset", "dziewięćset")
Slowo = ""
For Gr = 1 To 2
If Len(Liczba) - (Len(Liczba) \ 3) * 3 = 2 Then Liczba = "0" & Liczba
If Len(Liczba) - (Len(Liczba) \ 3) * 3 = 1 Then Liczba = "00" & Liczba
For i = 1 To (Len(Liczba) + 2) \ 3
SlowoP = ""
If i > 1 Then
LiczbaP = Mid(Liczba, Len(Liczba) - (i * 3) + 1, 3)
Else
LiczbaP = Liczba
End If
If Right(LiczbaP, 2) < 20 Then
SlowoP = Jednostki(Right(LiczbaP, 2)) & " " & SlowoP
Else
Slowo2 = Dziesiatki(Left(Right(LiczbaP, 2), 1))
Slowo2 = Slowo2 & " " & Jednostki(Right(LiczbaP, 1))
SlowoP = Slowo2 & " " & SlowoP
End If
If LiczbaP > 99 Then
SlowoP = Setki(Left(Right(LiczbaP, 3), 1)) & " " & SlowoP
End If
Select Case i
Case 1:
If CzyWaluta Then
If (Gr = 2) Then
Przyrostki = Array("grosz", "grosze", "groszy")
Else
Przyrostki = Array("złoty ", "złote ", "złotych ")
End If
Else
If (Gr = 2) Then
Przyrostki = Array("setna", "setne", "setnych")
Else
Przyrostki = Array("", "", "")
End If
End If
Case 2: Przyrostki = Array("tysiąc ", "tysiące ", "tysięcy ")
Case 3: Przyrostki = Array("milion ", "miliony ", "milionów ")
Case 4: Przyrostki = Array("miliard ", "miliardy ", "miliardów ")
Case 5: Przyrostki = Array("bilion ", "biliony ", "bilionów ")
End Select
If ((LiczbaP <> 0) And i > 1) Or (Gr > 0) Then
If LiczbaP <> 0 Then
If LiczbaP = 1 Then
Przyrostek = Przyrostki(0)
Else
If ((Right(LiczbaP, 1) > 1) And (Right(LiczbaP, 1) < 5)) Or _
((Right(LiczbaP, 2) > 21) And (Right(LiczbaP, 1) > 1) And _
(Right(LiczbaP, 1) < 5)) Then Przyrostek = Przyrostki(1)
If ((Right(LiczbaP, 2) > 4) And (Right(LiczbaP, 2) < 22)) Or _
((Right(LiczbaP, 2) > 21) And (Right(LiczbaP, 1) > 4) And _
(Right(LiczbaP, 1) < 22)) Or (Right(LiczbaP, 1) = 0) Or _
(Right(LiczbaP, 1) = 1) Then Przyrostek = Przyrostki(2)
End If
If Gr = 1 Then
Slowo = SlowoP & Przyrostek & Slowo
Else
Slowo = Slowo & SlowoP & Przyrostek
End If
End If
End If
Next i
If Grosze = "" Then
Exit For
Else
If Liczba > 0 Then If Gr = 1 Then Slowo = Slowo & "i "
Liczba = Grosze
End If
Next Gr
If Liczba = 0 Then Slowo = "zero" & Slowo
Słownie = IIf(IsEmpty(przedrostek), Slowo, przedrostek & Slowo)
End Function

tkuchta1 · Excel Expert Posty: 2270

chcę dorzucić drobnostkę od siebie:
Napisałem kiedyś kalkulator zamieniający wartość liczbową na słownie, oparty na funkcjach =mod, =jeżeli i =złącz.teksty działa w zakresie 0,01 - 20999,99 więc w porównaniu z waszymi nie ma o czym mówić, ale mi wystarcza więc nie widziałem potrzeby rozszerzania zakresu

Zaciekawił mnie fragment wypowiedzi Piotr_Korbicz dotycząca makra yesosenk:
makro umożliwia "zamianę na tekst również liczb ujemnych (jest takie zapotrzebowanie ze strony Forumowiczów)."

Sprawdzałem, że inne kalkulatory rzeczywiście nie działają w zakresie liczb ujemnych i tu moje 3 grosze:
Sory za banalny przykład ale:

A1 - [miejsce wprowadzania wartości liczbowej]
B1=ZNAK.LICZBY(A1)
C1=A1*B1
D1=JEŻELI(B1=(-1);"minus ";"")
E1=JEŻELI(C1=1;"jeden";JEŻELI(C1=2;"dwa";"inna"))
F1=ZŁĄCZ.TEKSTY(D1;E1)

Kalkulator dział w zakresie liczb całkowitych (-2,2)
******************************************************************
Edit::
ile razy to czytam to chcę to poprawić i jakoś normalnie wyartykułować. No i przyszła na to pora:
Jezeli dana funkcja nie działa w zakresie liczb ujemnych to wystarczy zamiast

Kod:

=slownie(A1)

wpisać

Kod:

=JEŻELI(A1<0;"minus "&slownie(A1*-1);slownie(A1))

Zefirek · Fan Excela Posty: 88

Witam.
Małe sprostowanie do funkcji, przy wpisaniu 18 wyjdzie odziemnaście.
Poprawcie bo na pewno ktoś będzie kopiował i używał.

magbo · Excel Expert Posty: 346

Brawo Zefir, sokole oko z ciebie. pzdr

Rysiu · forumowicz Posty: 17

Odnośnie wersji funkcji "Słownie" zamieszczonej przez Piotra Korbicza

Ciekawe, że w funkcji zadeklarowano jedne zmienne, a innych nie!
Wg jakich kryteriów?

Przy umieszczonym na początku modułu "Option Explicit" (bardzo zalecane)
jest oczywiście sygnalizowany błąd kompilacji,
więc w uzupełnieniu funkcji dobrze wstawić:

Dim przedrostek, Grosze, Jednostki, Dziesiatki, Setki, Gr, Przyrostki

[ Dodano: 2008-12-26, 18:10 ]
Przekształcenie kwoty zapisanej cyframi na zapis słowny
można również dokonać za pomocą dodatku ściągniętego stąd:

http://excel.republika.pl/dopobrania/slownie.htm

juniorrek · świeżak Posty: 1

faktycznie ta (http://excel.republika.pl/dopobrania/slownie.htm) dodatkowa funkcja jest najlepsza. jestem pod jej wrazeniem. niestety, ma niedociagniecia:

wpisujac

120 000,00 otrzymamy - sto dwadzieścia PLN
130 000,00 - sto trzydzieści PLN
bądź też

160 122,16 - sto sześćdziesiąt sto dwadzieścia dwa PLN, 16/100
(brakuje słowa "tysięcy")

czy ktos moglby pomoc mi wyeliminowac te usterki z tego dodatku?

bede bardzo wdzieczny. moj mail: juniorrek@o2.pl