Public Sub Точность_как_на_Экране() With ActiveWorkbook Select Case MsgBox("Сейчас = " _ & IIf(.PrecisionAsDisplayed, "ВКЛючена", "ОТключена") _ & vbCrLf & "" _ & vbCrLf & "Да = Переключить!" _ & vbCrLf & "" _ & vbCrLf & "Нет = Оставить как есть" _ , vbYesNo Or vbQuestion Or vbDefaultButton1, "Точность как на Экране") Case vbYes .PrecisionAsDisplayed = Not _ .PrecisionAsDisplayed Case vbNo ' ничего End Select End With Application.Calculate End Sub Private Sub Диапазон_Формулы_Обернуть_Формулой_test() Dim iLeft As String, iRight As String iLeft = "=ROUND(" iRight = ",2)" Диапазон_Формулы_Обернуть_Формулой Selection, iLeft, iRight End Sub Public Sub Диапазон_Формулы_Обернуть_Формулой(rng As Range, _ ByVal iLeft As String, _ ByVal iRight As String) ' Может пригодится для контроля округления копеек If Диапазон_Формулы_Наличие(rng) Then Set rng = rng.SpecialCells(xlCellTypeFormulas) Dim eL As Range, str_Formula As String For Each eL In rng With eL str_Formula = _ Replace$(.FormulaR1C1, "=", vbNullString, 1) .Formula = iLeft & str_Formula & iRight End With Next End If End Sub Private Sub Диапазон_Округление_Убрать_test() Диапазон_Округление_Убрать Selection End Sub Public Sub Диапазон_Округление_Убрать(rng As Range) If Диапазон_Формулы_Наличие(rng) Then Dim iLeft As String, iRight As String iLeft = "=ROUND(" iRight = ",2)" Dim eL As Range, str_Formula As String 'FormulaR1C1 = "=ROUND(RC[-2]*RC[-1],2)" For Each eL In rng With eL str_Formula = .FormulaR1C1 If left$(str_Formula, 7) = iLeft And _ Right$(str_Formula, 3) = iRight Then str_Formula = _ Replace$(str_Formula, iLeft, vbNullString, 1) str_Formula = _ left$(str_Formula, Len(str_Formula) - Len(iRight)) .Formula = "=" & str_Formula End If End With Next End If End Sub Public Function Диапазон_Формулы_Наличие(ByVal rng As Range) As Boolean On Error Resume Next If rng.SpecialCells(xlCellTypeFormulas).Count < 1 Then Диапазон_Формулы_Наличие = False Else Диапазон_Формулы_Наличие = True End If End Function