VB：切舍、切上、四捨五入 || 小數判斷

'********1*********2*********3*********4*********5*********6*********7**********
'*: Description: 丸め処理
'*: Argments: d = 原データ
'*:           FLG = 丸め區分(0:切り捨て 1:四捨五入 2:四捨五入)
'*:           M  = 小數の桁數
'********1*********2*********3*********4*********5*********6*********7**********
Public Function CF_cRound(ByVal d As Currency, FLG As Integer, M As Integer) As Currency
    Dim buf1 As Long
    Dim buf2 As Currency
    Dim Fugo As Integer

    If d <> 0 And M >= 0 Then
        Fugo = 0
        If Sgn(d) = -1 Then 'ﾏｲﾅｽの場合
            Fugo = 1    'Fugoﾌﾗｸﾞ = 1
        End If
        d = Abs(d)      '絶対値に換算
        buf1 = 10 ^ M
        If FLG = 0 Then '切り捨て
            buf2 = d * buf1
            buf2 = Int(buf2)
        ElseIf FLG = 1 Then     '四捨五入
            buf2 = d * buf1 + 0.5
            buf2 = Int(buf2)
        ElseIf FLG = 2 Then '切り上げ
            buf2 = d * buf1 + 0.9
            buf2 = Int(buf2)
        End If
        If Fugo = 1 Then
            CF_cRound = (buf2 / buf1) * -1
        Else
            CF_cRound = buf2 / buf1
        End If
    Else
        CF_cRound = d
    End If

End Function

 

 

‘*******************************************

Public Function CF_Chk_Shosu(ip_Text As String, ip_Seisu As Integer, ip_Shosu As Integer) As Boolean
'*: Argments: ip_Text  = チェック対象の文字列
'*:           ip_Seisu = 整數部桁數
'*:           ip_Shosu = 小數部桁數
    On Error GoTo Err_Exit
    Dim strText As String
    Dim intLen  As Integer
    Dim Pnt As Integer
   
    '數値として認識できなければエラー
    If IsNumeric(ip_Text) = False Then
        CF_Chk_Shosu = False
        Exit Function
    End If
   
    '頭にゼロがついていた場合削除
    strText = CStr(CDbl(ip_Text))
    intLen = Len(strText)
   
    '小數點位置を判定
    Pnt = InStr(strText, ".")
    '小數點なし
    If Pnt = 0 Then
        '桁數チェック
        If intLen <= ip_Seisu Then
            CF_Chk_Shosu = True
        Else
            CF_Chk_Shosu = False
        End If
   
    '整數部桁數オーバー
    ElseIf Pnt - 1 > ip_Seisu Then
        CF_Chk_Shosu = False
   
    '小數部桁數オーバー
    ElseIf intLen - Pnt > ip_Shosu Then
        CF_Chk_Shosu = False
   
    '正常
    Else
        CF_Chk_Shosu = True
   
    End If
   
    Exit Function
   
Err_Exit:
    CF_Chk_Shosu = False

End Function