Function GetNumbers(rCell As Range) As Long
 Dim LenStr As Long
 For LenStr = 1 To Len(rCell)
  Select Case Asc(Mid(rCell, LenStr, 1))
  Case 48 To 57
   GetNumbers = GetNumbers & Mid(rCell, LenStr, 1)
  End Select
 Next
End Function