..:: Nasvet/VBA ::..

Kako lahko znesek razbijem po posameznih bankovcih?


To potrebujejo predvsem v finančnih sferah, sama funkcija pa je precej preprosta!

Funkcija na vsakem koraku deli znesek z trenutno največjim bankovcem in si zapolni rezultat, ostanek pa deli z manjšim bankovcem ... vse do kovanca za 1SIT.

Potrebno pa je opozorilo o uporabi funkcije. Ta funkcija namreč vrne polje vrednosti (Array function), zato jo je potrebno v tabeli uporabiti pa poseben način. Najprej morate označiti 12 (!) celic in nato vpisati formulo (recimo: =RazbijZnesek(A1)) ter nato pritisniti <CTRL>+<SHIFT>+<ENTER>. V tem trenutku bo rezultat v vseh 12 celicah naenkrat. V prvi celici bo število potrebnih bankovcev po 10000SIT, v drugi 5000SIT.... in tako do 1SIT v zadni celici.

Celice morajo biti v isti vrstici in skupaj!

''' ''' Funkcija : RazbijZnesek ''' Namen : Podan znesek razbije po bankovcijh ''' Vrača : Polje s številom posameznih bankovcev ''' Vrne polje z dvanajstimi številkami ''' Polje(0) = število bankovcev po 10000 SIT ''' Polje(1) = število bankovcev po 5000 SIT ''' .... ''' Polje(11) = število bankovcev po 1 SIT ''' Argumenti : znesek (DOUBLE) - znesek, ki naj ga razbije ''' Napisal : Matjaž Prtenjak, 01/06/2000 ''' ''' !!POZOR!! : Funkcija ne vrača števila storinov! ''' Function RazbijZnesek(Znesek As Double) As Variant Dim utez As Variant ' uteži (vrednosti bankovcev) Dim denar(0 To 11) As Long ' število posameznih bankovcev Dim i As Integer ' števec Dim ostanek As Double ' pomožna spr. ' napolnim polje uteži utez = Array(10000, 5000, 1000, 500, 200, 100, 50, 20, 10, 5, 2, 1) ' izračunam števila ostanek = WorksheetFunction.RoundDown(Znesek, 0) For i = 0 To 11 denar(i) = ostanek \ utez(i) ostanek = ostanek Mod utez(i) Next ' vrnem števila RazbijZnesek = Array(denar(0), denar(1), denar(2), denar(3), _ denar(4), denar(5), denar(6), denar(7), _ denar(8), denar(9), denar(10), denar(11)) End Function



Navigacija

Se splača!

Tekmovanje

Najboljši krotilci kač...

Zadnje v forumu

14.07.2018 06:09:01: Text Import issues with Excel doc

01.07.2018 10:12:40: Zakaj ne zamenja preloma vrstice?

26.06.2018 15:27:11: Zakaj ne zamenja pisave?