Sub Мяу()
Dim ar, objRegExp As Object, SubMatches As Object, i&
ar = Range(Cells(2, "C"), Cells(Rows.Count, "B").End(xlUp)).Value
Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
.Global = True
.Pattern = "\d+"
For i = 1 To UBound(ar)
Set SubMatches = .Execute(ar(i, 1))
If SubMatches.Count = 2 Then
ar(i, 2) = SubMatches(0) * SubMatches(1)
If InStr(1, ar(i, 1), "долл", 1) Then
ar(i, 2) = ar(i, 2) * 70
ElseIf InStr(1, ar(i, 1), "евр", 1) Then
ar(i, 2) = ar(i, 2) * 80
End If
End If
Next
End With
Cells(2, "B").Resize(UBound(ar), 2).Value = ar
End Sub

Function ИЗВЛЕЧЬ_ЦЕЛЫЕ(ParamArray ДИАПАЗОН())
'---------------------------------------------------------------------------------------
' Author       : Alex_ST, v__step, nerv
' URL          : http://www.excelworld.ru/forum/3-1012-97065-16-1401961860
' Topic        : Функция (UDF) "ИЗВЛЕЧЬ_ЦЕЛЫЕ"
' Purpose      : Создать массив из целых чисел, извлечённых из текста произвольно расположенных ячеек
' Notes        : К полученному массиву можно применять любые стандартные формулы листа
'---------------------------------------------------------------------------------------
   Dim rArea, rCell, sStr$, oMatches, i&, Arr()
   On Error GoTo xlErrEXIT
   For Each rArea In ДИАПАЗОН
      For Each rCell In IIf(rArea.Count = 1, Array(rArea.Value), rArea.Value)
         sStr = sStr & " " & rCell
      Next rCell
   Next rArea
   With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "\d+": Set oMatches = .Execute(sStr): End With
   If oMatches.Count = 0 Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrNA): Exit Function      ' вернуть ошибку #Н/Д если чисел нет
   '   If oMatches Is Nothing Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrNA): Exit Function   ' вернуть ошибку #Н/Д если чисел нет
   ReDim Arr(1 To oMatches.Count)
   For i = 0 To oMatches.Count - 1: Arr(i + 1) = CLng(oMatches(i).Value): Next i
   ИЗВЛЕЧЬ_ЦЕЛЫЕ = Arr
xlErrEXIT:    If Err Then ИЗВЛЕЧЬ_ЦЕЛЫЕ = CVErr(xlErrValue)   ' вернуть ошибку #ЗНАЧ! если была ошибка
End Function