Форум по VBA и MS Office

Sub Макрос()

    Dim табл As Table, кэф As Double
    Dim var, r As Long, i As Long, j As Long
   
   
    ' Отключение монитора. Может это ускорит макрос.
    Application.ScreenUpdating = False
   
    '1. Здесь укажите коэффициент на который нужно изменить числа.
    кэф = 100 / 100
   
    '2. Присваиваем таблице имя "табл", далее в коде будем обращаться к таблице
        ' по этому имени.
    Set табл = ActiveDocument.Tables(1)
   
    '3. Движение по строкам таблицы со 2 по предпоследнюю.
    For i = 2 To табл.Rows.Count - 1
        ' Движение по двум последним столбцам таблицы.
        For j = 5 To 6
            ' Запись содержимого ячейки в переменную.
            var = табл.Cell(i, j).Range.Text
            ' Удаление двух спецсимволов, которые всегда есть в конце ячейки.
            var = Left(var, Len(var) - 2)
            ' Корректировка числа в соответствии с коэффициентом.
            var = var + var * кэф
            ' Округление числа до двух знаков после запятой.
            var = Format(var, "0.00")
            ' Запись числа обратно в ячейку.
            табл.Cell(i, j).Range.Text = var
        Next j
    Next i
   
    '4. Корректировка итоговой суммы в последней строке.
    r = табл.Rows.Count
    var = табл.Cell(r, 2).Range.Text
    var = Left(var, Len(var) - 2)
    var = var + var * кэф
    var = Format(var, "0.00")
    табл.Cell(r, 2).Range.Text = var
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub