[已解决]函数解决：公式按条件累加求和问题，希望大师帮帮忙

苏子龙

1. Function esum(rng As Range)
   
2.     Dim arr, reg As Object
   
3.     Dim str As String, he#, n%
   
4.     arr = rng
   
5.     n = UBound(arr, 2)
   
6.     Set reg = CreateObject("vbscript.regexp")
   
7.     With reg
   
8.         .Pattern = "[^0-9\*+-/（()）]"
   
9.         .Global = True
   
10.     End With
    
11.     For i = 1 To UBound(arr)
    
12.         If arr(i, n) <> "" Then
    
13.             str = reg.Replace(arr(i, 1), "")
    
14.             he = he + evaluate(str)
    
15.         End If
    
16.     Next
    
17.     esum = he
    
18. End Function

复制代码

hupin6331

花小剑 发表于 2016-11-28 21:36
有附件，里面详细说明：函数解决：公式按条件累加求和问题，希望大师帮帮忙

这样可以吗？

花小剑

苏子龙 发表于 2016-11-29 14:09

谢谢你，辛苦了，已设置为最佳答案

花小剑

hupin6331 发表于 2016-11-30 16:16
这样可以吗？

谢谢你，不过F列的公式是随意编辑的且单元格的行数随编辑会增加，还是谢谢哈辛苦了。

苏子龙

苏子龙 发表于 2016-11-29 14:09

1. Function esum(rng As Range) As Double
   
2.     Dim arr, reg As Object, str$, n%, i%
   
3.     arr = rng: n = UBound(arr, 2)
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Pattern = "\[.*?\]" '"[^0-9\*+-/（()）]"这个中括号内有数字就错了
   
6.         .Global = True
   
7.         For i = 1 To UBound(arr)
   
8.             If arr(i, n) <> "" Then
   
9.                 str = .Replace(arr(i, 1), "")
   
10.                esum = esum + Evaluate(str)
    
11.             End If
    
12.         Next
    
13.     End With
    
14. End Function

复制代码