Newsgroup: it.comp.appl.access
Titolo: Funzione di arrotondamento per eccesso con decimali  kg o quintali

Ciao a tutti, 
come state? 
Mi sto incartando con una funzione che mi dovrebbe aiutare ad arrotondare per eccesso dei valori (servono per il calcolo dei trasporti, in ogni caso il valore dovrà essere arrotondato al kg o al quintale superiore.
 
Ecco un esempio di ciò che vorrei:
 
38.1 = 39
38.01 = 39
500.1= 501
500.01= 501
 
Public Function DecRoundEccesso(ICampo As Double) As Double
 
'funzione per arrotondare per eccesso
 
    On Error GoTo DecRound_Error
 
 
    Dim icent As Double
    Dim arrotonda As Double
    icent = 0
    icent = CDec(ICampo - Int(ICampo))
 
    Select Case icent
 
    Case 0.01 To 0.99
        arrotonda = 1
 
'grrr qui non funziona per niente ... maledetta!
    Case 0.1 To 1
        arrotonda = 10
 
    End Select
 
    DecRoundEccesso = Int(ICampo) + arrotonda
 
    On Error GoTo 0
    Exit Function
 
DecRound_Error:
 
    MsgBox "Error " & err.Number & " (" & err.Description & ") in procedure DecRound of Function Modulo1"
 
End Function
 
Qualcuno ha qualche suggerimento? Secondo voi dovrei fare un case per capire se si tratta di kg, decine di kg o quintali e poi giocarmela lì il cambio di decimale?
 
grazie un caro saluto e a presto!
matteo

Ciao Matteo.
Non riesco oggi ad addentrarmi nel merito, quindi ti incollo 2 funzioni:
 
Function Eccesso(ByVal NumIn As Variant, DecArrot As Integer) As Variant
 
    ' NumIn     = Numero in ingresso
    ' DecArrot  = Numero di decimali al quale arrotondare.
 
    Dim varNum      As Variant 'Numero valutato
    Dim varIn       As Variant
    'Controllo la validità del Numero
    If IsNumeric(NumIn) Then
        varIn = CDec(NumIn)
    Else
        varIn = 0
    End If
 
    varNum = Abs(varIn)
    'Arrotondo e recupero il segno dopo l'arrotondamento
    Eccesso = Sgn(varIn) * (Fix(varNum * (10 ^ DecArrot) + 0.99999) / (10 ^ DecArrot))
 
End Function
Per provarla:
[code]
 
?Eccesso(10.4376,2)
=10.44
 
?Eccesso(-10.4376,2)
-10,44 
 
?Eccesso(-10.4376,3)
-10,438 
 
?Eccesso(10.4376,3)
10,438 
 
?Eccesso(10.4376,1)
10,5 
 
?Eccesso(10.4376,0)
11 
 
 
[MODIFICA]
Dimenticavo, funziona anche per numeri interi... passando il Decimale negativo
 
?Eccesso(1088,-1)
1090 
 
?Eccesso(1088,-2)
1100
 
?Eccesso(1088,-3)
2000 
 
Questa variante invece consente sia l'eccesso che il difetto:
 
Function Arrotonda(ByVal NumIn As Variant, _
                   AlDecimale As Integer, _
                   Optional Eccesso As Boolean = True) As Variant
 
    ' [NumIn]           Numero in ingresso
    ' [AlDecimale]      Numero di decimali al quale arrotondare.
    ' [Eccesso]         True=Eccesso / False=Difetto
 
    Dim varNum      As Variant  'Variabile
    Dim varIn       As Variant  'Numero valutato
    Dim sgnInc      As Single   'Numero di incremento per l'ECCESSO
 
    'Controllo la validità del Numero
    If IsNumeric(NumIn) Then
        ' Converto in DECIMAL per la precisione(14Byte)
        varIn = CDec(NumIn)
    Else
        varIn = 0
    End If
    ' Il 5° decimale è per assicurare l'arrotondamento commerciale(4° decimale)
    ' Se ECCESSO=True  --->(+ 0.99999)
    ' Se ECCESSO=False --->(0)    
    sgnInc = Abs(Eccesso) * 0.99999
    varNum = Abs(varIn)
    'Arrotondo e recupero il segno dopo l'arrotondamento    
    varNum = (Fix(varNum * (10 ^ AlDecimale) + sgnInc) / (10 ^ AlDecimale))
    Arrotonda = Sgn(varIn) * varNum
End Function

Grazie Alex! 
Le testo e verifico, anche io non posso perderci troppo tempo.
Ti incollo qui una funzione che ho trovato googolando che forse funziona.
 
 
https://www.excelvba.it/Forum/story/Visual_Basic_for_Applications/Arrotondare_per_eccesso.html
 
 
Function ArrotondaB(ByVal NumIn As Variant, _
                   AlDecimale As Integer, _
                   Optional Eccesso As Boolean = True) As Variant
 
    ' [NumIn]           Numero in ingresso
    ' [AlDecimale]      Numero di decimali al quale arrotondare.
    ' [Eccesso]         True=Eccesso / False=Difetto
 
    Dim varNum      As Variant  'Variabile
    Dim varIn       As Variant  'Numero valutato
    Dim sgnInc      As Single   'Numero di incremento per l'ECCESSO
 
    'Controllo la validità del Numero
    If IsNumeric(NumIn) Then
        ' Converto in DECIMAL per la precisione(14Byte)
        varIn = CDec(NumIn)
    Else
        varIn = 0
    End If
    ' Il 5° decimale è per assicurare l'arrotondamento commerciale(4° decimale)
    ' Se ECCESSO=True  --->(+ 0.99999)
    ' Se ECCESSO=False --->(0)
    sgnInc = Abs(Eccesso) * 0.99999
    varNum = Abs(varIn)
    'Arrotondo e recupero il segno dopo l'arrotondamento
    varNum = (Fix(varNum * (10 ^ AlDecimale) + sgnInc) / (10 ^ AlDecimale))
    ArrotondaB = Sgn(varIn) * varNum
End Function


Mi fa piacere vedere le mie Funzioni spacciate per Funzioi di altri, ma l'ha rinominata... ;-)
 
Io l'ho scritta nel 2007:
http://forum.masterdrive.it/microsoft-office-access-vba-23/arrotonda-in-eccesso-18809/
 
 
Fa nulla, va bene anche così...!
 
Ciao
@Alex

in effetti dopo ho rivisto la tua ed erano identiche!
;-)
 
grazie alex sempre il migliore!



forse non ho capito il problema
 
ma
 
tuoNumero=int(tuonumero)+1
 
cosa ha che non va?
è una riga di codice
 
BFS
 
 
 

Prova ad inserire un intero... ti soddisfa come risultato...?
 
Esempio 50... non mi pare che 51 sia l'arrotondamento di 50.
 
Ecco con 1 riga di.codice proprio magari non è abbastanza.
 
Ovviamente si può banalizzare tutto...
 
@Alex


beh testare se serve richiamare una funzione lo do per scontato
con if then else diventano 5 righe totali
 
 

 con if then else diventano 5 righe totali
 
Infatti quello che ho suggerito tolti i commenti(didattici) erano 6... sono troppe...?
 
Sempre quella 1 Riga di troppo...
 
Saluti
@Alex