Как всегда иметь 2 десятичных знака на двойном - PullRequest
0 голосов
/ 10 января 2019

У меня есть макрос, который просматривает список текста, извлекает суммы в долларах, увеличивает их на 12% и заменяет текст обновленными суммами в долларах.

Вот как выглядит пара строк данных: enter image description here

Это результат после запуска макроса: enter image description here

Мне нужно, чтобы 72.8 было, например, 72.80.

Иногда результат будет иметь только 1 десятичный знак, а иногда - 3. Функция Round отлично работает для меня, урезая результат до 2 десятичных знаков, но не помогает добавить 0, чтобы сохранить число в двух десятичных разрядах.

Мне нужен способ заполнить второе десятичное место 0, если результат имеет только 1 десятичное место.

Это макрос:

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 голосов
/ 12 января 2019
changedDollarAmount = CDbl(dollarAmount) * 1.12 * 0.01

cell.Formula = Replace(cell.Formula, originalDollarAmount, Format$(changedDollarAmount, "$0.00"))
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...