如何始终在Double上保留2个小数位

时间:2019-01-10 18:43:17

标签: excel vba

我有一个宏,它遍历文本列表,提取美元金额,将其增加12%,然后用更新的美元金额替换文本。

几行数据如下所示: enter image description here

这是运行宏后的结果: enter image description here

例如,我需要72.872.80

有时结果只保留小数点后1位,有时甚至有3个小数。Round函数对我来说很好,可以将结果截断到2个小数位,但无助于保留0小数点后两位的数字。

如果结果只有1个小数位,我需要用0填充第二个小数位。

这是宏:

Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit").   '
Dim retval As String    ' This is the return string.      '
Dim i As Integer        ' Counter for character position. '

' Initialise return string to empty                       '
retval = ""

' For every character in input string, copy digits to     '
'   return string.                                        '
For i = 1 To Len(s)
    If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
        retval = retval + Mid(s, i, 1)
    End If
Next

' Then return the return string.                          '
onlyDigits = retval
End Function

Sub ChangeDollarAmount()

Dim qtyspec As String
Dim previousDollarIndex As Integer
Dim dollarSignCount As Integer
Dim dollarString As String
Dim originalDollarAmount As String
Dim changedDollarAmount As Double
Dim isANumber As Boolean

previousDollarIndex = 1

' row count
lastrow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count

For Each cell In Range("K2:K" & lastrow)
    Debug.Print cell.Formula

    previousDollarIndex = 1
    qtyspec = cell.Formula
    dollarSignCount = (Len(cell.Formula) - Len(Replace(cell.Formula, "$", ""))) / Len("$")

    ' loop through dollar amounts in text
    For i = 1 To dollarSignCount
        isANumber = False
        previousDollarIndex = InStr(previousDollarIndex + 1, cell.Formula, "$")
        originalDollarAmount = Mid(cell.Formula, previousDollarIndex, 8)

        Do While isANumber = False
            If Not IsNumeric(Right(originalDollarAmount, 1)) Then
                originalDollarAmount = Left(originalDollarAmount, Len(originalDollarAmount) - 1)
            Else
                isANumber = True
            End If
        Loop

        ' extract only digits from dollar amount ($345.23 -> 34523)
        dollarAmount = onlyDigits(originalDollarAmount)

        ' add decimal point and increase dollar amount by 12% (34523 -> 345.23 -> 386.66)
        changedDollarAmount = Round(CDbl(dollarAmount) * 1.12 * 0.01, 2)

        ' update the dollar amount in the text
        cell.Formula = Replace(cell.Formula, originalDollarAmount, "$" + CStr(changedDollarAmount))
    Next i

Next cell

End Sub

1 个答案:

答案 0 :(得分:1)

changedDollarAmount = CDbl(dollarAmount) * 1.12 * 0.01

cell.Formula = Replace(cell.Formula, originalDollarAmount, Format$(changedDollarAmount, "$0.00"))