Access ：四捨五入

Accessで小数を丸める関数は、Int・Fix・Cint・Round があります。

Roundでできそうな感じですができません。
Round関数は、4以下は切り捨て、6以上は切り上げ、5は元の数値が偶数になるよう、切捨てか切り上げが行われるからです。
詳しくはこちらを参照してください。

そこで四捨五入関数を自作することにします。

[構文]
Function MyRound(f As Double, n1 As Long) As Double
ｆには元の数値を指定します。
n1は桁位置を指定します。

Home　

Tips　

メニュー

■ サンプルソフト実行画面

・ 1桁位置で実行　
765.432 が 765 となり、切り捨てられています。
四捨五入関数ソフト

・ 2桁位置で実行　
765.432 が 765.4 となり、切り捨てられています。
四捨五入サンプルソフト

・ 3桁位置で実行　
765.432 が 765.43 となり、切り捨てられています。
切捨て実行画面

・ 1桁位置で実行　
1234.567 が 1235 となり、切り上げられています。
1桁目で切り上げ画面

・ 2桁位置で実行
1234.567 が 1234.6 となり、切り上げられています。
2桁目で切り上げ画面

・ 3桁位置で実行
1234.567 が 1234.57 となり、切り上げられています。
3桁目で切り上げ画面

■ Access VBA 実行コード

Option Compare Database
Option Explicit

'四捨五入
Private Function MyRound(f As Double, n1 As Long) As Double
    Dim pos As Integer
    Dim s1 As String
    Dim nval As Integer
    Dim srcnum As String
    Dim signed As Long
    Dim roundval As Double
    '桁を上げる
    f = f * 10 ^ n1
    srcnum = Str(f)
    If f >= 0 Then
        signed = 1
    Else
        signed = -1
    End If
    '小数点位置までループ
    For pos = 1 To Len(srcnum)
        If Mid(srcnum, pos, 1) = "." Then
            '次の数字
            nval = Val(Mid(srcnum, pos + 1, 1))
            Exit For
        End If
        s1 = s1 & Mid(srcnum, pos, 1)
    Next
    roundval = Val(s1)
    '5以上であれば
    If nval >= 5 Then
        roundval = roundval + signed
    End If
    '桁位置を戻す
    MyRound = roundval / (10 ^ n1)
End Function

Private Sub コマンド10_Click()
    Dim f As Double
    If IsNull(Me!テキスト0) Then
        MsgBox "四捨五入する数値を入力してください。"
        Me!テキスト0.SetFocus
        Exit Sub
    End If
    f = MyRound(Me!テキスト0, Me!フレーム2 - 1)
    '結果表示
    Me!テキスト11 = f
End Sub

Home　

Tips　

メニュー

Access ： 四捨五入

Accessで小数を丸める関数は、Int・Fix・Cint・Round があります。

■ Access VBA 実行コード

Access ：四捨五入