VB.NET实现GB/T 8170-2008规定的四舍六入五留双修约方式

以下通过两种方法实现GB/T 8170-2008中规定的数值修约方式，也可叫做四舍六入五留双规则，代码个人验证时暂未发现问题，仅做参考，可根据自己需求优化，如有问题可在评论区讨论。

方法一：

采用系统自带的Math.Round函数

Dim TempDbl As Double '双精度浮点数临时变量
TempDbl = 初始值 '这里将需要修约的数值或计算过程赋值给TempDbl
TempDbl = Format(TempDbl, "#0.0000") '根据实际需求降低精度，此处为降低至小数点后4位，否则根据修约规则该舍去的可能会导致进位
目标值 = Math.Round(TempDbl, 2, MidpointRounding.ToEven) '保留两位小数

方法二：

自写判断逻辑函数，传参即可

''输入数值，保留几位小数
    Public Shared Function round_gbt8170(ByVal data_val As Decimal, ByVal len As Integer) As Decimal 
        Dim num As String = data_val.ToString()
        Dim zs As String = num.Split("."c)(0) '整数
        Dim xs As String = ""
        If num.Split("."c).Length > 1 Then '以小数点分组，索引从0开始，起码2组下面才能取索引1，所以此处需大于1
            xs = num.Split("."c)(1) '小数
        End If

        If len >= xs.Length Then
            xs = xs.ToString().PadRight(len, "0"c)
        Else
            Dim lxs As String = ""
            If len > 1 Then lxs = xs.Substring(0, len - 1)
            Dim ds As Integer = Convert.ToInt32(xs.Substring(len - 1, 1)) '取保留小数位数的数字
            Dim ns As Integer = Convert.ToInt32(xs.Substring(len, 1)) '取保留小数位数的下一位数字

            If ns < 5 Then '舍去
                xs = lxs & ds.ToString()
            ElseIf ns > 5 Then '进1
                xs = lxs & (ds + 1).ToString()
            ElseIf ns = 5 Then
                Dim hs As String = "" '取保留小数位数的下一位数字的后面所有数字
                If xs.Length - 1 > len Then hs = xs.Substring(len + 1)

                If hs <> "" AndAlso Convert.ToInt32(hs) > 0 Then '舍弃数字的最左一位数字是 5,且其后有非0数字时进一,即保留数字的末位数字加1
                    xs = lxs & (ds + 1).ToString()
                Else '拟舍弃数字的最左一位数字为5,且其后无数字或皆为0时,若所保留的末位数字为奇数(1,3，5,7,9)则进一，即保留数字的末位数字加1;若所保留的末位数字为偶数(0,2,4,6,8),则舍去。
                    If ds Mod 2 = 0 Then '所保留的末位数字为偶数(0, 2, 4, 6, 8),则舍去
                        xs = lxs & ds.ToString()
                    ElseIf ds Mod 2 = 1 Then '若所保留的末位数字为奇数(1,3，5,7,9)则进一，即保留数字的末位数字加1
                        xs = lxs & ds.ToString()
                        xs = lxs & (ds + 1).ToString()
                    End If
                End If
            End If
        End If

        Dim fh As Decimal = data_val

        If len > 0 Then
            fh = Convert.ToDecimal(zs & "." & xs)
        Else
            fh = Convert.ToDecimal(zs)
        End If

        Return fh
    End Function