VBA自定义函数：从文本中提取数字

Function ExtractNumber(rCell As Range, _
 Optional Take_decimal As Boolean, _
 Optional Take_negative As Boolean) As Double
 
 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
 Dim vVal, vVal2
 Dim c As Range
 
 For Each c In rCell
   sText = c
   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
 
   If Not IsNumeric(lNum) Then lNum = 0
 
   ExtractNumber = ExtractNumber + CDbl(lNum)
   lNum = ""
 Next
End Function