=-ЕСЛИОШИБКА(-C2;СУММ(-(ПСТР(C2;СТОЛБЕЦ(1:1);1)="*")))

Function cnt%(str$)
       Dim arr As Variant
       If IsNumeric(str) Then
           cnt = str * 1
       Else
           arr = Split(str, "*")
           cnt = UBound(arr)
       End If
End Function

Function NewOrProlonged(ContragentColNum As Integer, SquareColNum As Integer)
'NewOrProlonged = Application.WorksheetFunction.SumProduct((Range(Cells(7, ContragentColNum), Cells(EntireRow.Row, ContragentColNum)) = Cells(EntireRow.Row, ContragentColNum)) * (Range(Cells(7, SquareColNum), Cells(EntireRow.Row, SquareColNum)) = Cells(EntireRow.Row, SquareColNum)))
Dim rngContragent$, rngSquare$, crtContragent$, crtSquare$
       With Application.Caller
           crtContragent = Cells(.Row, ContragentColNum).Address
           crtSquare = Cells(.Row, SquareColNum).Address
           rngContragent = Range(Cells(8, ContragentColNum), Cells(.Row - 1, _
               ContragentColNum)).Address
           rngSquare = Range(Cells(8, SquareColNum), Cells(.Row - 1, _
               SquareColNum)).Address
       End With
       NewOrProlonged = Evaluate("SumProduct((" & rngContragent & " = " & _
           crtContragent & ")*(" & rngSquare & "=" & crtSquare & "))")
       'NewOrProlonged = Evaluate("SumProduct((" & rngContragent & "=" & crtContragent _
           & ")*(" & rngContragent & "<>"""")*(" & rngContragent & ">0)*(" & rngSquare & _
           "=" & crtSquare & ")*(" & rngSquare & "<>"""")*(" & rngSquare & ">0))")
End Function

Sub tt()
       Dim arr(), r%
       r = 4
       arr = Application.Transpose(Range("A1:A" & r))
       MsgBox Join(arr)
End Sub

Debug.Print c; AscW(c)

Debug.Print AscW("ваш квадрат")

DOCPROPERTY  ab

Sub Document_Open()
       Dim ff As Field
       For Each ff In ActiveDocument.Fields
           With ff.Code.Find
               .Text = ChrW(8722): .Replacement.Text = "-"
               .Execute Replace:=wdReplaceAll
               .Text = ChrW(8725): .Replacement.Text = "/"
               .Execute Replace:=wdReplaceAll
               .Text = ChrW(8727): .Replacement.Text = "*"
               .Execute Replace:=wdReplaceAll
           End With
       Next
End Sub