利用自定义函数抽取字符串中的数值

yivifu

论坛上有超级高手发布了一个公式，可以抽取字符串中的正数、负数或所有数值分别求和。高手的公式（要输入成数组公式）如下：

正数和：

=SUM(TEXT(LEFT(TEXT(MID(A2&"a",COLUMN(2:2),ROW($1:$15)),),ROW($1:$15)-1),"[>];\0;0;!0")*ISERR(-MID(A2,COLUMN(2:2)-1,2)))

负数和：

=SUM(-TEXT(LEFT(TEXT(MID(A2&"a",COLUMN(2:2),ROW($1:$15)),),ROW($1:$15)-1),"[<];;\0;!0")*ISERR(-MID(A2,COLUMN(2:2)-1,2)))

全部和：

=SUM(TEXT(LEFT(TEXT(MID(A2&"a",COLUMN(2:2),ROW($1:$15)),),ROW($1:$15)-1),"[<>];;0;!0")*ISERR(-MID(A2,COLUMN(2:2)-1,2)))

示例文件中给出了如下字符串进行测试：

五晨152 可是中-1956.36 酃有时地365在0

测试结果全部正确。但是，如果你将测试字符串中的“152”改成“15-2”，正常理解应该是字符串中包含了一个整数15和一个负数-2，但是公式计算正数和和全部和的结果时却出错了。

另外，如果你将“-1956.36”改成“--1956.36”，按excel的运算规则应该是将-1956.36变成了正数，这个公式也不能得出正确结果。

尽管有这些问题，这个公式仍然让人大开眼界，给人许多启示，因此，应该对原作者表示敬意。由于这个公式上没法应用F9进行按步骤的分析，我也没能力修正其中的bug，但是却让我产生了一个念头：编制一个自定义函数用于抽取字符串中的数值。

在excel中，数值可以包含的合法字符是数字、正负号和小数点，我们可以从头开始扫描字符串，遇到合法数值字符时创建一个临时字符串开始记录，记录完成后再扫描余下部分，遇到合法数值字符又创建一个新的临时字符串开始记录，最后将临时字符串数组中的数值转换成数值类型后返回，这就是基本思路。按这个思路完成的自定义函数如下：

1. '辅助函数，判断字符是否是合法数值字符
   
2. Private Function InCharset(c As String) As Boolean
   
3.     If c = "." Or c = "+" Or c = "-" Or IsNumeric(c) Then
   
4.         InCharset = True
   
5.     Else
   
6.         InCharset = False
   
7.     End If
   
8. End Function

复制代码

1. '按excel数值规则抽取字符串中的所有数值，作为双精度数组返回。字符串中无数值时返回仅包含一个元素的双精度数组，该数组只有一个0值。
   
2. Function ExtractNumber(str As String) As Double()
   
3.     Dim i%, j%, currC$, preC$, tmp() As String, res() As Double
   
4.     j = -1: preC = ""
   
5.     For i = 1 To Len(str)
   
6.         currC = Mid(str, i, 1)
   
7.         If InCharset(currC) Then '当前字符是合法数字字符
   
8.             If i > 1 Then preC = Mid(str, i - 1, 1)
   
9.             '如果前一字符不是合法数字字符，那么新建临时字符串准备存放新的数字串
   
10.             If Not InCharset(preC) Then
    
11.                 j = j + 1
    
12.                 ReDim Preserve tmp(j)
    
13.                 tmp(j) = tmp(j) & currC
    
14.             '如果前一字符是正号或负号
    
15.             ElseIf preC = "+" Or preC = "-" Then
    
16.                 '跟随小数点或数字，直接连接到临时字符串中
    
17.                 If currC = "." Or IsNumeric(currC) Then
    
18.                     tmp(j) = tmp(j) & currC
    
19.                 '如果跟随字符是负号，那么将临时字符串中的数字符号变号，如果跟随正号，丢弃，不予处理
    
20.                 ElseIf currC = "-" Then
    
21.                     If tmp(j) = "+" Then
    
22.                         tmp(j) = "-"
    
23.                     ElseIf tmp(j) = "-" Then
    
24.                         tmp(j) = "+"
    
25.                     End If
    
26.                 End If
    
27.             '如果前一字符是小数点或数字
    
28.             ElseIf preC = "." Or IsNumeric(preC) Then
    
29.                 '如果跟随小数点
    
30.                 If currC = "." Then
    
31.                     '如果临时字符串中已包含小数点，那么前一数字的解析终止，创建新的临时字符串存放新的数字串
    
32.                     If InStr(1, tmp(j), currC) Then
    
33.                         j = j + 1
    
34.                         ReDim Preserve tmp(j)
    
35.                     End If
    
36.                     '将小数点连接到临时字符串中
    
37.                     tmp(j) = tmp(j) & currC
    
38.                     
    
39.                 '如果跟随正负号，那么前一数字的解析终止，创建新的临时字符串存放新的数字串
    
40.                 ElseIf currC = "-" Or currC = "+" Then
    
41.                     j = j + 1
    
42.                     ReDim Preserve tmp(j)
    
43.                     tmp(j) = tmp(j) & currC
    
44.                 '如果跟随数字，那么直接连接到临时字符串中
    
45.                 ElseIf IsNumeric(currC) Then
    
46.                     tmp(j) = tmp(j) & currC
    
47.                 End If
    
48.             End If
    
49.         End If
    
50.     Next
    
51.     '如果字符串中不包含数字，那么创建一个数组返回
    
52.     If j = -1 Then
    
53.         ReDim Preserve res(0)
    
54.     Else
    
55.         i = 0
    
56.         For j = LBound(tmp) To UBound(tmp)
    
57.             '剔除临时字符串数组中没跟数字的小数点和正负号的字串，并将符合要求的字符串转换为数值后返回
    
58.             If IsNumeric(tmp(j)) Then
    
59.                 ReDim Preserve res(i)
    
60.                 res(i) = tmp(j) * 1
    
61.                 i = i + 1
    
62.             End If
    
63.         Next
    
64.     End If
    
65.     ExtractNumber = res
    
66. End Function

复制代码

然后用以下公式可以如文首提到的那些牛X公式分别求正数和、负数和和全部和（需输入数组公式，测试字符串放在“G27”单元格中）：

正数和：

=SUM((ExtractNumber($G$27)>0)*1*ExtractNumber($G$27))

负数和：

=SUM((ExtractNumber($G$27)<0)*1*ExtractNumber($G$27))

全部和：

=SUM((ExtractNumber($G$27))

将其中包含的数值分列显示：

=IF(ISERROR(INDEX(ExtractNumber($G$27),,COLUMN(A:A))),"没有了",INDEX(ExtractNumber($G$27),,COLUMN(A:A)))

向右拉，一直到显示“没有了”为止。

这个函数并没有多少实际用途，主要用来练习一下动态数组、返回值为数组的函数、字符串与数字的转换、自定义函数的应用等。另外，字符串的解析过程与编译原理中的词法分析与语法分析过程非常类似，是吗？于是借此锻炼了一下思维。

LIUZHU

有这么复杂吗，现在用正则式提取不是很方便？

香川群子

【这个函数并没有多少实际用途，主要用来练习一下……】

楼主说得好。这个函数其实毫无用处。呵呵。

yivifu

正则表达式当然也可以啦

1. '用正则表达式完成与上面函数相同的功能
   
2. Function ExtractNumberWithRegex(ByVal str As String) As Double()
   
3.     Dim res() As Double, regEx As Object, matchs As Object, match As Variant, i%, minusCount%
   
4.     Set regEx = CreateObject("vbscript.regexp")
   
5.     With regEx
   
6.         .Pattern = "[+-]*[\d]*[\.]?[\d]+" '匹配数字的正则表达式，按excel单元格公式规则，不用[+-]?而用[+-]*
   
7.         .Global = True '取所有匹配结果
   
8.         Set matchs = .Execute(str)
   
9.     End With
   
10.     ReDim Preserve res(matchs.Count - 1)'vba数组的下标也是从0开始，为什么不保持一致从1开始？
    
11.     For Each match In matchs
    
12.         match = Replace(match, "+", "") '正号对数值没有影响，全部消掉
    
13.         minusCount = Len(match) '记录去掉负号前的字符串长度
    
14.         match = Replace(match, "-", "") '去掉负号
    
15.         minusCount = minusCount - Len(match) '去掉负号前后的字符串长度差即负号个数
    
16.         '如果负号个数为奇数，则在字符串前加上一个负号
    
17.         If minusCount Mod 2 = 1 Then match = "-" & match
    
18.         '用val函数将文本型的字符串转换成数值时，无法正确转换一个以上连续的正负号，前面五行代码即用于处理这个问题
    
19.         res(i) = Val(match)
    
20.         i = i + 1
    
21.     Next
    
22.     ExtractNumberWithRegex = res
    
23. End Function

复制代码

不过，如果不是在处理正负号方面有一些巧妙的地方，我还真的懒得用这种方法。

liu-aguang

yivifu 发表于 2014-8-12 18:42
正则表达式当然也可以啦不过，如果不是在处理正负号方面有一些巧妙的地方，我还真的懒得用这种方法。

1. Function AAA(cel As Range)
   
2.     With CreateObject("vbscript.regexp")
   
3.         .Pattern = "[^\d.-]+"
   
4.         .Global = True
   
5.         AAA = Application.Evaluate(.Replace(cel, "+") & "+0")
   
6.     End With
   
7. End Function
   

复制代码

yivifu

liu-aguang 发表于 2014-8-12 19:26

谢谢指教。
这个函数本来用途不大，返回一个数组就是希望用途稍大一点，例如可以分列提取，可以像帖子开头那样分别求正数、负数的和等，因为这个毕竟是人家提出的要求，所以也许多少有这样的需求。

吹吹

to yivifu:
    谢谢你的这个函数，用其扩展开来，真的大有用途！！！