'JISの丸めを行う関数

'指定桁+1以降がちょうど500...のとき、指定桁が偶数ならば切り捨て、
'奇数ならば切り上げます。それ以外の場合は通常の四捨五入をします。

'数値を15桁の文字列に変換して判定しています。

Option Explicit

'小数点以下n桁の数値に丸める関数

'使用例
'小数点以下2桁で丸めます。結果は0.02です。
'=JRnd1(0.025,2)

Function JRnd1(ByVal dfNumber As Double, ByVal iDigits As Integer) As Double
    Const iStepNum As Integer = 5
    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
        JRnd1 = 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
            '端数が基準値と等しく、指定桁までの数値が偶数の場合、切り捨てる
            If dfNum1 = Int(dfNum1 / 2) * 2 Then
                iUp = 0
            Else
                iUp = 1
            End If
        Else

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

        End If
    End If

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

End Function


'有効数字n桁の数値に丸める関数

'使用例
'有効数字4桁で丸めます。結果は1.234です。
'=JRnd2(1.2345,4)

Function JRnd2(ByVal dfNumber As Double, ByVal iDigits As Integer) As Variant
    Const iStepNum As Integer = 5
    Dim sNumber As String
    Dim iExponent  As Integer
    Dim dfResult As Double
    Dim dfNum1 As Double
    Dim dfNum2 As Double
    Dim dfNum3 As Double
    Dim iUp As Integer

    '引数のチェック
    If (iDigits <= 0) Or (iDigits > 15) Then
        JRnd2 = CVErr(xlErrValue)
        Exit Function
    End If

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

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

    '指定桁までの数値を取得
    dfNum1 = CDbl(Mid$(sNumber, 1, iDigits))

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

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

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

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

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

        End If
    End If

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