标题:四舍六入小程序,有甚么问题吗?
只看楼主
hytf
Rank: 1
等 级:新手上路
帖 子:56
专家分:0
注 册:2007-5-11
 问题点数:0 回复次数:9 
四舍六入小程序,有甚么问题吗?

Private Function GetNumber(f As Double, iPos As Integer) As String
Dim k As Integer
Dim i As Integer
Dim s As String
Dim s1 As String
Dim s2 As String
Dim k1, k2 As Integer


s = Trim$(CStr(f))
i = InStr(1, s, ".") '查找小数点的位置
'检查是否需要进行处理
s1 = Mid(s, i + iPos + 1, 1)
s2 = Mid(s, i + iPos, 1)
k1 = Val(s1)
k2 = Val(s2)

If iPos = 0 Then
If i > 0 Then s1 = Left$(s, i)
Else '小数点后是否有大于精度的位数。不大于则不需处理
If Len(s) - i > iPos Then '最后一位<5:舍去,>5:进位,=5:奇进偶舍

If k < 5 Then '舍去
s1 = Left$(s, i + iPos)
ElseIf k > 5 Then '进位
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim(Str(k))
ElseIf k = 5 Then '奇进偶舍
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k2 = Val(Len(s)) - i - iPos

If k2 = 0 Then '偶舍
If k Mod 2 = 0 Then
s1 = Left$(s, i + iPos)
Else '奇进
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
Else
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
End If
End If
End If
' s1 = Format(s1, "####0.000")
' Print s1
GetNumber = CStr(s1) '送回处理后的数据
End Function

搜索更多相关主题的帖子: Dim Integer String iPos 程序 
2007-08-02 08:44
slore
Rank: 5Rank: 5
等 级:贵宾
威 望:16
帖 子:1108
专家分:0
注 册:2005-7-1
得分:0 


Private Function GetNumber(f As Double, iPos As Integer) As String
Dim
k As Integer
Dim
i As Integer
Dim
s As String
Dim
s1 As String
Dim
s2 As String
Dim
k1 As Integer, k2 As Integer ''As Integer不可以省略不然k1为Variant


s = CStr(f) ''CStr不存在前导空位不需要Trim
i = InStr(1, s, ".") '查找小数点的位置
'检查是否需要进行处理
s1 = Mid(s, i + iPos + 1, 1)
s2 = Mid(s, i + iPos, 1)
k = Val(s1) ''这里错误了。下面是k你本身却写的是k1
k2 = Val(s2)

If iPos = 0 Then
If
i > 0 Then s1 = Left$(s, i)
Else '小数点后是否有大于精度的位数。不大于则不需处理
If Len(s) - i > iPos Then '最后一位<5:舍去,>5:进位,=5:奇进偶舍

If k < 5 Then '舍去
s1 = Left$(s, i + iPos)
ElseIf k > 5 Then '进位
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim(Str(k))
ElseIf k = 5 Then '奇进偶舍
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k2 = Len(s) - i - iPos ''Len返回Long数据不需要Val转换

If k2 = 0 Then '偶舍
If k Mod 2 = 0 Then
s1 = Left$(s, i + iPos)
Else '奇进
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
Else
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
End If
Else
''如果精确位数小于原长度
s1 = f ''返回原数字
End If
End If
' s1 = Format(s1, "####0.000")
' Print s1
GetNumber = CStr(s1) '送回处理后的数据
End Function

其实系统内部提供了这样一个函数,下面是我写的函数
Private Function SGetNumber(f As Double, iPos As Integer) As String
SGetNumber = LTrim$(Round(f, iPos))
End Function


快上课了……
2007-08-02 10:10
心中有剑
Rank: 2
等 级:新手上路
威 望:5
帖 子:611
专家分:0
注 册:2007-5-18
得分:0 

什么叫四舍6入啊!
round函数不可以实现吗?


2007-08-02 16:38
hytf
Rank: 1
等 级:新手上路
帖 子:56
专家分:0
注 册:2007-5-11
得分:0 
关键是该舍的不舍,该进的不进啊
2007-08-05 08:14
hytf
Rank: 1
等 级:新手上路
帖 子:56
专家分:0
注 册:2007-5-11
得分:0 

Private Function GetNumber(f As Double, iPos As Integer) As String
Dim k As Integer
Dim i As Double
Dim s As String
Dim s1 As String
Dim s2 As String
Dim k1 As Double, k2 As Double
s = CStr(f)
i = InStr(1, s, ".") '查找小数点的位置
'检查是否需要进行处理
s1 = Mid(s, i + iPos + 1, 1)
s2 = Mid(s, i + iPos, 1)
k = Val(s1)
k2 = Val(s2)
If Len(s) - i < iPos Then
MsgBox "小数位数不足,请人工检查"
End If
If Len(s) - i = iPos Then s1 = s
If Len(s) - i > iPos Then '最后一位<5:舍去,>5:进位,=5:奇进偶舍

If k < 5 Then '舍去
s1 = Left$(s, i + iPos)
ElseIf k > 5 Then '进位
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim(Str(k))
ElseIf k = 5 Then '奇进偶舍
s1 = Mid(s, i + iPos, 1)
k = Val(s1)
k2 = Len(s) - i - iPos - 1
If k2 = 0 Then '偶舍
If k Mod 2 = 0 Then
s1 = Left$(s, i + iPos)
Else '奇进
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
Else
k = k + 1
s1 = Left$(s, i + iPos - 1) + Trim$(Str(k))
End If
End If
End If

' s1 = Format(s1, "####0.000")
' Print s1
GetNumber = CStr(s1) '送回处理后的数据
End Function


基本能满足要求了,就是当小数位数太多的时候,不能舍去
比如1.05450000000000000000000000000152保留三位小数,应当是1.055,程序显示却是1.054

2007-08-05 09:18
slore
Rank: 5Rank: 5
等 级:贵宾
威 望:16
帖 子:1108
专家分:0
注 册:2005-7-1
得分:0 
我给你改的那个是1.055(1.05450000000000000000000000000152在VB里后面的是被省略掉了,结果是1.0545)

快上课了……
2007-08-05 10:48
hytf
Rank: 1
等 级:新手上路
帖 子:56
专家分:0
注 册:2007-5-11
得分:0 

是啊,但是那个1.0545,保留三位小数时,应该是1.054啊!结果也是1.055呢

2007-08-06 11:32
hytf
Rank: 1
等 级:新手上路
帖 子:56
专家分:0
注 册:2007-5-11
得分:0 
有人解决吗?
2007-08-14 08:49
西风独自凉
Rank: 8Rank: 8
等 级:贵宾
威 望:43
帖 子:3380
专家分:28
注 册:2007-8-2
得分:0 

i=insert(1,s,".")
n=i+3
m=mid(s,n,1)
if m>=6 then
text1.text=left(s,i) +0.01 ’六进
else
text1.text=left(s,i) '五舍?(你要的是四舍。。。那如果是5你要怎样)
end if

[此贴子已经被作者于2007-8-14 9:01:19编辑过]


2007-08-14 08:58
hytf
Rank: 1
等 级:新手上路
帖 子:56
专家分:0
注 册:2007-5-11
得分:0 
TjvlEU1e.rar (8.48 KB) 四舍六入小程序,有甚么问题吗?


麻烦给改改吧!!
2007-08-15 16:27



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-159811-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.761166 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved