If Right(Cell.Value, 1) = "*" Then zvezda = "*"

If Right(X, 1) = "*" Then X = val(Left(X, Len(X) - 1)) Else X = val(X)

If Right(CStr(Cell.Value), 1) = "*" Then

                        If CStr(Cell.Value) Like "\*" Then zvezda = "*": _
                    Cell.Value = Replace(Cell.Value, Chr(42), "") _
                    Else: zvezda = ""

                    ' Сохраняем адресс ячейки, если есть * для того чтоб её после вернуть обратно
                    If Right(Cell.Text, 1) = "*" Then
                        starCells(Cell.Address) = True
                        Cell.Value = Replace(Cell.Value, "*", "")
                    End If


Sub Summa2()
    Dim i As Long, j As Long, k As Long
    Dim Cell        As Range
    Dim CellVal     As Double
    Dim Key         As Variant

    Dim starCells   As Object
    Set starCells = CreateObject("Scripting.Dictionary")    ' Для хранения адресов с *

    With ThisWorkbook.Worksheets("обработка")

        Dim List    As String
        List = CStr(.Cells(1, 2).Value)

        Dim LastRowObr As Long
        LastRowObr = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    With ThisWorkbook.Worksheets(List)

        Dim LastRowList As Long
        LastRowList = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range(.Cells(2, 3), .Cells(LastRowList, 10)).Replace What:=".", replacement:=",", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False
    End With

    For i = 5 To LastRowObr

        Dim add     As Double
        add = val(ThisWorkbook.Worksheets("обработка").Cells(i, "C").Value) / 1000

        For j = 2 To LastRowList
            If CStr(ThisWorkbook.Worksheets(List).Cells(j, "B").Value) = CStr(Sheets("обработка").Cells(i, "A").Value) Then

                For k = 3 To 10
                    Set Cell = ThisWorkbook.Worksheets(List).Cells(j, k)

                    If Len(Trim(Cell.Text)) = 0 Or Cell.Text = "*" Then GoTo SkipCell

                    ' Сохраняем адресс ячейки, если есть * для того чтоб её после вернуть обратно
                    If Right(Cell.Text, 1) = "*" Then
                        starCells(Cell.Address) = True
                        Cell.Value = Replace(Cell.Value, "*", "")
                    End If

                    On Error Resume Next
                    CellVal = CDbl(Cell.Value)
                    On Error GoTo 0

                    CellVal = CellVal + add
                    Cell.Value = Format(CellVal, "0.00")

SkipCell:
                Next k

            End If
        Next j
    Next i

    ' Возвращаем * обратно
    For Each Key In starCells.Keys
        ThisWorkbook.Worksheets(List).Range(Key).Value = ThisWorkbook.Worksheets(List).Range(Key).Value & "*"
    Next Key

    Set starCells = Nothing
End Sub

CellVal = CDbl(Cell.Value)

On Error Resume Next
                    CellVal = CDbl(Cell.Value)
                    On Error GoTo 0

                    CellVal = CellVal + add

                    ' Проверка: можно ли безопасно конвертировать в число
                    If IsNumeric(Cell.Value) Then
                        CellVal = CDbl(Cell.Value)
                        CellVal = CellVal + add
                        Cell.Value = Format(CellVal, "0.00")
                    End If