это вряд ли. А второй выложенный файл ПодбитьСумму.zip решает полностью Вашу проблему. ПопробуйтеВсеже проще делать тупо ручками

Модератор: Naeel Maqsudov
Код: Выделить всё
Private Sub CommandButton1_Click()
Dim Len_str As Integer
Dim Start_exp As Integer
Dim End_exp As Integer
Dim iCell As Range
Dim r1 As Range
'1500+90=1590-600=990-500=490-
For Each iCell In Selection
Set r1 = iCell
Len_str = Len(r1.Value)
'Очистка цвета всего теста
r1.Characters(Start:=1, Length:=Len_str).Font.ColorIndex = 0
Start_exp = 1
For i = 1 To Len_str
'Поиск очередного выражения
If Mid(r1.Value, i, 1) = "=" Then
'Поиск конца выражения
For j = i To Len_str
If Mid(r1.Value, j, 1) = "+" Or Mid(r1.Value, j, 1) = "-" Then
End_exp = j - 1
GoTo 1
End If
Next j
End_exp = Len_str 'когда конец выражения не определен знаком действия [1500+90=1590-600=990-500=490]
1:
'Проверка выражения
dfdf = Mid(r1.Value, Start_exp, End_exp - Start_exp + 1)
d = Application.Evaluate(Mid(r1.Value, Start_exp, End_exp - Start_exp + 1))
'Выделение результата
If d = True Then
r1.Characters(Start:=i + 1, Length:=End_exp - i).Font.ColorIndex = 5
Else
r1.Characters(Start:=i + 1, Length:=End_exp - i).Font.ColorIndex = 3
End If
Start_exp = i + 1
End If
Next i
Next
End Sub