四舍六入五成双算法模块（数值，修约位数）修约后数值

Public Function Fun4s6r5cs(ByVal value1 As Double, ByVal weishu As Integer) As Double '数据修约算法   Fun4s6r5cs
    Dim c, d, e, f As Double
    c = value1* 10 ^ weishu
    e = Int(c)
    d = (c - e) / 10 ^ weishu
    f = e / 10 ^ weishu
    If d <> (5 / 10 ^ (weishu + 1)) Then '当修约位数不满足“五成双”时，Round函数做四舍五入算法
    Fun4s6r5cs = Round(value1, weishu)
    Else
       If (e Mod 2) = 0 Then'当修约位数满足“五成双”时，看修约位奇偶
          Fun4s6r5cs = f'偶数即当前位数数值
        Else
          Fun4s6r5cs = f + 1 / 10 ^ weishu'奇数即进1位
       End If
    End If
End Function