ビットマップから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 |