Newsgroup: it.comp.lang.visual-basic
Titolo: Arrotondamenti Eccesso Difetto

Salve Gente.
Dato un Importo( in Euro Ovviamente)
ES1 : 1.056,49  Risultato = 1.056,00
ES2 : 1.056, 51 Risultato = 1.057,00
Se dopo la Virgola e < 49 Arrotonda Dopo la Virgola per Difetto =,00
Se dopo la Virgola e > 51 Arrotonda a  Dopo la Virgola per Eccesso =
1,056,51 +0,49 =1.057,00
Come Posso Fare ?
Grazie in anticipo a chi Fosse Disponibile per risolvere !!!

 1,056,51 +0,49 =1.057,00
Quel < è in realtà un <=?
Somma il decimale che ti interessa e poi usa Fix

 Come Posso Fare ?
private function fnArrotonda(Valore as double) as double
    dim tmp as double
    tmp=Valore-int(Valore)
    if tmp<0.49 then fnArrotonda=int(Valore)
    if tmp>0.51 then fnArrotonda=int(Valore)+1
end function
CIAO

In Poche Parole Mi Sono Costruito una Function Per La Somma
di un Preventivo :
Devo Effettuare un Arrotondamento Automatico :
Esempio : sel la Somma del Preventivo = 1.033,56
                risultato dell'arotondamento = 1.034,00
Esmpio :  sel la Somma del Preventivo = 1.033,45
                risultato dell'arotondamento = 1.033,00
Come devo applicare Ciň
Grazie !!!!

 ha scritto nel
messaggio news:GVHM8.25603$86.6...@twister1.libero.it...

Claudio, insisterei per la Fix. Cosa fa la Int per un numero negativo?

 wrote in message
private function fnArrotonda(ByVal Valore as double) as Long
    '                        ^^^^^                      ^^^^
    ' !!! Attenzione all'indicatore # di tipo!!!
    if (Valore-Fix(Valore)) < 0.50# then
        fnArrotonda=Fix(Valore)
    Else
        fnArrotonda=Fix(Valore)+1
    End if
end function
Ciao

 ha scritto nel messaggio
news:NvHM8.22125$5i1.8...@news2.tin.it...


     if (Valore-Fix(Valore)) < 0.50# then
CIAO

 cosa cč che non va nelle parti sottolineate? (^^^^^^^^^)
Niente, č una sottolineatura del byval e del tipo di risultato.
Ciao

 Usare la funzione Round non sarebbe piů veloce????
Sě, ma usa l'arrotondamento bancario :)
Debug.Print Round(2.5)
Debug.Print Round(3.5)
Ciao


prendere l'arrotondamento che si vuole ottenere (0.50)
diminuirlo in misura del numero più piccolo con tale precisione (0.01)
si ottiene un coefficiente (0.50 - 0.01 = 0.49)
tale coefficiente va sommato (per arrotondamenti in eccesso) al numero da
arrotondare prima di eseguire la funzione int
Es. arrotondare 16,14
INT(16.14 + 0.49)=16
arrotondare 16,51
INT(16.51 + 0.49)=17
P.S. sostituire la funzione INT con FIX permette la validità del principio
anche per i numeri negativi
--
Mauro
www.cerretosoft.it

 Come devo applicare Ciò
Risultato = Int(SommaPreventivo + 0.5)
--
Er Roscio.

 Come Posso Fare ?
[...]
Copia/Incolla nella pagina del codice di Form1 su cui avrai piazzato una
matrice di 5 Label1, una di 5 Text1 ed un Command1:
Option Explicit
Public Enum myRoundStylesEnum
  StyleFloor
  StyleRound
  StyleCeiling
End Enum
Private Enum myControlsEnum
  txtNumber = 0
  txtNumDigits = 1
  txtFloor = 2
  txtRound = 3
  txtCeiling = 4
End Enum
Private Const c_sNumber = "Numero"
Private Const c_sDec = "Decimali"
Private Const c_sFloor = "Arr. Dif."
Private Const c_sRound = "Arr. Mat."
Private Const c_sCeiling = "Arr. Ecc."
Private Function myRound( _
  ByVal Number As Double _
, ByVal NumDigits As Integer _
, Optional ByVal RoundStyle As myRoundStylesEnum = StyleRound _
) As Double
  Dim dTemp As Double
  dTemp = 10 ^ NumDigits
  Number = Number * dTemp
  If RoundStyle = StyleRound Then
    myRound = CDbl(Format$(Number, "0")) / dTemp
  ElseIf RoundStyle = StyleFloor Then
    myRound = Int(Number) / dTemp
  ElseIf RoundStyle = StyleCeiling Then
    myRound = -Int(-Number) / dTemp
  End If
End Function
Private Sub Command1_Click()
  On Error GoTo errh
  Const c_sFormat = "#,##0.00"
  Dim bCont   As Boolean
  Dim lErr    As Long
  Dim dNumber As Double
  Dim iDec    As Integer
  bCont = True
  If bCont = True Then
    On Error Resume Next
    dNumber = Me.Text1(txtNumber).Text
    bCont = Err.Number = 0
    On Error GoTo errh
  End If
  If bCont = True Then
    On Error Resume Next
    iDec = Me.Text1(txtNumDigits).Text
    bCont = Err.Number = 0
    On Error GoTo errh
  End If
  If bCont = True Then
    With Me.Text1
      .Item(txtFloor).Text _
        = Format$(myRound(dNumber, iDec, StyleFloor), c_sFormat)
      .Item(txtRound).Text _
        = Format$(myRound(dNumber, iDec, StyleRound), c_sFormat)
      .Item(txtCeiling).Text _
        = Format$(myRound(dNumber, iDec, StyleCeiling), c_sFormat)
    End With
  Else
    With Me.Text1
      .Item(txtFloor).Text = ""
      .Item(txtRound).Text = ""
      .Item(txtCeiling).Text = ""
    End With
  End If
ext:
  Exit Sub
errh:
  With Err
    MsgBox .Description, , .Number
  End With
  Resume ext
End Sub
Private Sub Form_Load()
  With Me
    With .Label1
      .Item(txtNumber).Caption = c_sNumber & ":"
      .Item(txtNumDigits).Caption = c_sDec & ":"
      .Item(txtFloor).Caption = c_sFloor & ":"
      .Item(txtRound).Caption = c_sRound & ":"
      .Item(txtCeiling).Caption = c_sCeiling & ":"
    End With
    With .Text1
      With .Item(txtNumber)
        .Text = "-123,456"
      End With
      With .Item(txtNumDigits)
        .Text = "-2"
      End With
      With .Item(txtFloor)
        .Text = ""
        .Locked = True
      End With
      With .Item(txtRound)
        .Text = ""
        .Locked = True
      End With
      With .Item(txtCeiling)
        .Text = ""
        .Locked = True
      End With
    End With
    With .Command1
      .Default = True
      .Caption = "Ok"
    End With
  End With
End Sub
Private Sub Text1_GotFocus( _
  ByRef Index As Integer)
  With Me.Text1(Index)
    .SelStart = 0
    .SelLength = Len(.Text)
  End With
End Sub
--
Ciao.
Maurizio
--------
?SPQR(C)
 X
--------