Пересчет данных в таблице по примеру.

Option Base 1
Dim oCell As Cell
Dim MyArray_1(17) As String
Dim MyArray_2(19) As String
Dim MyArray_3(20) As String
Dim vData_1 As Long
Dim vData_2 As Long
Sub m_1()
On Error Resume Next
'Заполняем массивы цифрами
    MyArray_1(1) = 2
    MyArray_1(2) = 4
    MyArray_1(3) = 6
    MyArray_1(4) = 8
    MyArray_1(5) = 10
    MyArray_1(6) = 12
    MyArray_1(7) = 14
    MyArray_1(8) = 16
    MyArray_1(9) = 18
    MyArray_1(10) = 20
    MyArray_1(11) = 22
    MyArray_1(12) = 24
    MyArray_1(13) = 26
    MyArray_1(14) = 28
    MyArray_1(15) = 30
    MyArray_1(16) = 32
    MyArray_1(17) = 34
        MyArray_2(1) = 5
        MyArray_2(2) = 10
        MyArray_2(3) = 15
        MyArray_2(4) = 20
        MyArray_2(5) = 25
        MyArray_2(6) = 30
        MyArray_2(7) = 35
        MyArray_2(8) = 40
        MyArray_2(9) = 45
        MyArray_2(10) = 50
        MyArray_2(11) = 55
        MyArray_2(12) = 60
        MyArray_2(13) = 65
        MyArray_2(14) = 70
        MyArray_2(15) = 75
        MyArray_2(16) = 80
        MyArray_2(17) = 85
        MyArray_2(18) = 90
        MyArray_2(19) = 95
    MyArray_3(1) = 100
    MyArray_3(2) = 110
    MyArray_3(3) = 120
    MyArray_3(4) = 130
    MyArray_3(5) = 140
    MyArray_3(6) = 150
    MyArray_3(7) = 160
    MyArray_3(8) = 170
    MyArray_3(9) = 180
    MyArray_3(10) = 190
    MyArray_3(11) = 200
    MyArray_3(12) = 210
    MyArray_3(13) = 220
    MyArray_3(14) = 230
    MyArray_3(15) = 240
    MyArray_3(16) = 250
    MyArray_3(17) = 260
    MyArray_3(18) = 270
    MyArray_3(19) = 280
    MyArray_3(20) = 290
'Предупреждаем, что курсор нужно вставить в Таблицу
    If Selection.Cells.Count = 0 Then
        MsgBox "Вставьте курсор в Таблицу, в которой надо изменить цифры!", vbCritical + vbOKOnly, "Предупреждение"
        Exit Sub
    End If
    On Error GoTo 0
'Обрабатываем ячейки, содержащие "дефис"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With ActiveDocument.Range.Find
        .Text = "-"
        .Replacement.Text = ""
        .Replacement.Font.Animation = wdAnimationMarchingBlackAnts
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
'Отделяем первую строку от Таблицы. Иначе не получится работать с конкретным столбцом, т.к. имеет место объединение ячеек.
    Selection.Tables(1).Rows(2).Select
    Selection.SplitTable
    Selection.MoveDown
'Отталкиваемся от 11 Столбца, чтобы обработать те ячейки, которые заполнены с 5 по 10 столбец
    For Each oCell In Selection.Tables(1).Columns(11).Cells
    If oCell.Shading.BackgroundPatternColor = wdColorLightYellow Then
        oCell.Select
            For x = 1 To 6
                Selection.MoveLeft Unit:=wdCell, Extend:=wdExtend
                If Selection.Text = "-" Or Selection.Characters.Count = 1 Then
                    GoTo metka
                End If
            Next
    Selection.Rows(1).Range.Font.Animation = wdAnimationMarchingRedAnts
    End If
metka:
    Next
'Заменяем цифры. В этом случае заменяются цифры, которые не идут подряд с 5 по 10 столбец.
    For Each oCell In Selection.Tables(1).Range.Cells
        oCell.Select
        If oCell.Shading.BackgroundPatternColor = wdColorLightYellow And oCell.Range.Font.Animation = wdAnimationNone _
            And Selection.Characters.Count > 1 Then
                vData_1 = Left(Selection.Text, Selection.Characters.Count - 1)
                    If InStr(Join(MyArray_1()), vData_1) > 0 Then
                        Selection.TypeText vData_1 + 2
                    ElseIf InStr(Join(MyArray_2()), vData_1) > 0 Then
                        Selection.TypeText vData_1 + 5
                    ElseIf InStr(Join(MyArray_3()), vData_1) > 0 Then
                        Selection.TypeText vData_1 + 10
                    End If
        End If
    Next
'Обрабатываем цифры, которые идут в ячейках с 5 по 10 столбец
    For Each oCell In Selection.Tables(1).Range.Cells
        oCell.Select
        If oCell.Shading.BackgroundPatternColor = wdColorLightYellow And oCell.Range.Font.Animation = wdAnimationMarchingRedAnts _
            And Selection.Characters.Count > 1 Then
                vData_1 = Left(Selection.Text, Selection.Characters.Count - 1)
                    If InStr(Join(MyArray_1()), vData_1) > 0 Then
                        vData_2 = vData_1 + 2
                        Selection.TypeText vData_2
                    ElseIf InStr(Join(MyArray_2()), vData_1) > 0 Then
                        vData_2 = vData_1 + 5
                        Selection.TypeText vData_2
                    ElseIf InStr(Join(MyArray_3()), vData_1) > 0 Then
                        vData_2 = vData_1 + 10
                        Selection.TypeText vData_2
                    End If
                    oCell.Select
                    Selection.Copy
                    Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
                    Selection.Paste
                    Selection.MoveRight
                    Selection.Cells(1).Select
                    Selection.TypeText Int(vData_2 / 2)
                    Selection.Cells(1).Select
                    Selection.Copy
                    Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
                    Selection.Paste
                    Selection.Rows(1).Range.Font.Animation = wdAnimationNone
        End If
    Next
'Переходим вверх над Таблицу, чтобы вернуть первую строку обратно
    Selection.Tables(1).Select
    Selection.MoveUp
    If Selection.Characters.Count = 1 Then
        Selection.Delete
    End If
'Убираем всю Анимацию из Документа. Я использовал Анимацию, чтобы выборочно работать с текстом и цифрами в Таблице.
    ActiveDocument.Range.Font.Animation = wdAnimationNone
End Sub

'Переходим вверх над Таблицу, чтобы вернуть первую строку обратно
    Selection.Tables(1).Select
    Selection.MoveUp

Selection.Paragraphs(1).Range.Select