'Format 関数を使った丸め関数

'指定桁での四捨五入、五捨六入、JIS 丸め などを行います。
'数値をFormat関数で15桁の文字列に変換し、計算します。

'FRound(dfNumber, iDigits, iStepNum, iUpOrDown)
'
'引数
'  dfNumber : 数値
'  iDigits  : 丸める桁(1のとき 0.1 の桁、-1 のとき 1 の桁)
'  iStepNum : 端数の基準値
'             5: 四捨五入, 6:五捨六入, 0:切り上げ, 10,切り捨て
'  iUpOrDown: 端数がちょうど基準値の場合の処理
'             0: 切り捨て, 1:切り上げ, 2:丸める桁が偶数のとき切り捨て、奇数のとき切り上げ

'使用例
'小数点以下 4 桁に五捨六入で丸めます。結果は 9000.0509 です。
'=FRound(9000.05086,4,6,1)

Option Explicit

Function FRound(ByVal dfNumber As Double, ByVal iDigits As Integer, _
        ByVal iStepNum As Integer, ByVal iUpOrDown As Integer) As Double
    Dim sNumber As String
    Dim iExponent  As Integer
    Dim iDigits2 As Integer
    Dim dfResult As Double
    Dim dfNum1 As Double
    Dim dfNum2 As Double
    Dim dfNum3 As Double
    Dim iUp As Integer

    '数値を15桁の文字列に変換
    sNumber = Mid$(Format(Abs(dfNumber), ".000000000000000E+000"), 2)

    '指数部を取得
    iExponent = CInt(Mid$(sNumber, 17))

    '文字列上の丸める桁を取得
    iDigits2 = iExponent + iDigits

    '丸める桁が15より大きい場合はそのまま値を返す
    If iDigits2 > 15 Then
        dfResult = CDbl("0." & sNumber)
        If dfResult <> 0 Then
            dfResult = Sgn(dfNumber) * dfResult
        End If
        FRound = dfResult
        Exit Function
    End If

   '指定桁までの数値を取得
    If iDigits2 < 1 Then
        dfNum1 = 0
    Else
        dfNum1 = CDbl(Mid$(sNumber, 1, iDigits2))
    End If

   '指定桁+1の数値を取得
    If (iDigits2 < 0) Or (iDigits2 >= 15) Then
        dfNum2 = 0
    Else
        dfNum2 = CInt(Mid$(sNumber, iDigits2 + 1, 1))
    End If

    '指定桁+1の数字の判定
    If dfNum2 < iStepNum Then
        iUp = 0
    ElseIf dfNum2 > iStepNum Then
        iUp = 1
    Else

        '指定桁+2以降の数値を取得
        If iDigits2 >= 14 Then
            dfNum3 = 0
        ElseIf iDigits2 < -1 Then
            dfNum3 = CDbl(Mid$(sNumber, 1, 15))
        Else
            dfNum3 = CDbl(Mid$(sNumber, iDigits2 + 2, 14 - iDigits2))
        End If

        '端数が基準値と等しい場合は指定に従う
        If dfNum3 = 0 Then
            Select Case iUpOrDown
                Case 0
                    iUp = 0
                Case 1
                    iUp = 1
                Case 2
                    '指定桁までの数値が偶数の場合、切り捨てる
                    If dfNum1 = Int(dfNum1 / 2) * 2 Then
                        iUp = 0
                    Else
                        iUp = 1
                    End If
                Case Else
                    iUp = 1
            End Select
        Else

            '端数が基準値より大きい場合は切り上げる
            iUp = 1

        End If
    End If

    dfResult = (dfNum1 + iUp) * (10 ^ (iExponent - iDigits2))
    If dfResult <> 0 Then
        dfResult = Sgn(dfNumber) * dfResult
    End If
    FRound = dfResult

End Function