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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!