Sub Test()
Dim arr As Variant
Dim x As Variant
Dim str As String
Dim i As Long
arr = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 2).Value
For i = LBound(arr, 1) To UBound(arr, 1)
If InStr(arr(i, 1), "USD") > 0 Then
str = "USD"
ElseIf InStr(arr(i, 1), "GPB") > 0 Then
str = "GPB"
ElseIf InStr(arr(i, 1), "CNY") > 0 Then
str = "CNY"
Else
str = ""
End If
If str <> "" Then x = ExtractNumber(CStr(Split(arr(i, 1), str)(1)), 1): arr(i, 2) = CStr(x)
Next i
Range("A2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub
Function ExtractNumber(rCell, Optional Take_decimal As Boolean, Optional Take_negative As Boolean) As Double
Dim vVal As Variant
Dim vVal2 As Variant
Dim iCount As Integer
Dim i As Integer
Dim iLoop As Integer
Dim sText As String
Dim strNeg As String
Dim strDec As String
Dim lNum As String
sText = rCell
If Take_decimal = True And Take_negative = True Then
strNeg = "-"
strDec = "."
ElseIf Take_decimal = True And Take_negative = False Then
strNeg = vbNullString
strDec = "."
ElseIf Take_decimal = False And Take_negative = True Then
strNeg = "-"
strDec = vbNullString
End If
iLoop = Len(sText)
For iCount = iLoop To 1 Step -1
vVal = Mid(sText, iCount, 1)
If IsNumeric(vVal) Or vVal = strNeg Or vVal = strDec Then
i = i + 1
lNum = Mid(sText, iCount, 1) & lNum
If IsNumeric(lNum) Then
If CDbl(lNum) < 0 Then Exit For
Else
lNum = Replace(lNum, Left(lNum, 1), "", , 1)
End If
End If
If i = 1 And lNum <> vbNullString Then lNum = CDbl(Mid(lNum, 1, 1))
Next iCount
ExtractNumber = CDbl(lNum)
End Function