● 切り捨て・切り上げ・四捨五入を行う ●

ビットマップからAVIファイルを作成するで「切り捨て処理」の箇所を修正した際、VBには「切り捨て」「切り上げ」「四捨五入」の組み込み関数って無いよね、と思ったので作成した次第。ぱぱっと作ったのでバグ的な虫が沸いているかも。

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能:切り捨てを行う
' 引  数:(i)TargetValue … 切り捨て対象とする値
'         (i)Digit       … 対象桁数  正の数:整数部  負の数:小数部
' 返り値:切り捨てられた値  Digitが 0 の場合は TargetValue が返る
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function RoundDown(ByVal TargetValue As Double, ByVal Digit As Long) As Double
    If Digit = 0 Then RoundDown = TargetValue: Exit Function
    '小数点以下部
    If Digit < 0 Then
        '面倒なので文字列化して該当部分をブッコ抜く ↓整数部の文字数+小数点1文字+小数部分
        'RoundDown = CDbl(Left$(CStr(TargetValue), Len(CStr(Fix(TargetValue))) + 1 + (Abs(Digit) - 1)))
        RoundDown = CDbl(Left$(CStr(TargetValue), Len(CStr(Fix(TargetValue))) + Abs(Digit))) '上を省略
    '整数部
    Else
        RoundDown = Fix(TargetValue / (10 ^ Digit)) * (10 ^ Digit)
    End If
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能:切り上げを行う
' 引  数:(i)TargetValue … 切り上げ対象とする値
'         (i)Digit       … 対象桁数  正の数:整数部  負の数:小数部
' 返り値:切り上げられた値  Digitが 0 の場合は TargetValue が返る
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function RoundUp(ByVal TargetValue As Double, ByVal Digit As Long) As Double
    RoundUp = RoundEx(TargetValue, Digit, 9)
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能:四捨五入を行う
' 引  数:(i)TargetValue … 四捨五入対象とする値
'         (i)Digit       … 対象桁数  正の数:整数部  負の数:小数部
' 返り値:四捨五入された値  Digitが 0 の場合は TargetValue が返る
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function Round(ByVal TargetValue As Double, ByVal Digit As Long) As Double
    Round = RoundEx(TargetValue, Digit, 5)
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能:切り上げ または 四捨五入を行う
' 引  数:(i)TargetValue … 切り上げ または 四捨五入対象とする値
'         (i)Digit       … 対象桁数  正の数:整数部  負の数:小数部
'         (i)BaseNum     … 境界値の元となる数(四捨五入:5  切り上げ:9)
' 返り値:切り上げ または 四捨五入された値
'         Digitが 0 の場合は TargetValue が返る
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function RoundEx(ByVal TargetValue As Double, ByVal Digit As Long, _
                        ByVal BaseNum As Long) As Double
    If Digit = 0 Then RoundEx = TargetValue: Exit Function
    '小数点以下部
    If Digit < 0 Then
        '桁数に応じた境界値を加算し、対象桁で切り捨てる
        RoundEx = RoundDown(TargetValue + ((0.1 ^ Abs(Digit)) * BaseNum), Digit)
    '整数部
    Else
        '桁数に応じた境界値を加算し、対象桁で切り捨てる
        RoundEx = RoundDown(TargetValue + ((10 ^ (Digit - 1)) * BaseNum), Digit)
    End If
End Function

戻る