从备注中读取金额并计算

lijian318

在B1单元格输入文本格式的年-月，查找出备注中对应年月后的金额并求和，结果填在B2单元格

lijian318

自顶一下     

Yalishanda30

试试看，不一定正确

白薯beyond

请见附件。

代码如下。第一次写正则代码，请路过的老师帮忙看看有哪些可以改进的地方，谢谢。

1. Sub 提取()
   
2. Dim arr, i%, sum&, reg As Object
   
3. arr = Split(Range("a2"), Left(Range("b1"), 5))
   
4. Set reg = CreateObject("vbscript.regexp")
   
5. With reg
   
6.     .Global = True
   
7.     .Pattern = "\d+"
   
8.     For i = 0 To UBound(arr)
   
9.         If Left(arr(i), 2) = Right(Range("b1"), 2) Then
   
10.             sum = sum + .Execute(Split(arr(i), "线上代扣")(1))(0)
    
11.         End If
    
12.     Next
    
13. End With
    
14. Range("b2") = sum
    
15. End Sub

复制代码

microyip

1. Sub 计算()
   
2.     Dim vData As Variant, nRow As Integer, vFill As Variant
   
3.     Dim regExp As Object, sStr As String, oData As Object, nData As Integer
   
4.     Dim nSum As Double
   
5.    
   
6.     vData = Sheet1.UsedRange.Value
   
7.     If UBound(vData) < 2 Then Exit Sub
   
8.     ReDim vFill(2 To UBound(vData), 1 To 1)
   
9.     Set regExp = CreateObject("vbscript.regexp")
   
10.     With regExp
    
11.         .Global = True
    
12.         .Pattern = "线上代扣\d+"
    
13.         For nRow = 2 To UBound(vData)
    
14.             sStr = vData(nRow, 1)
    
15.             nSum = 0
    
16.             Set oData = .Execute(sStr)
    
17.             If oData.Count > 0 Then
    
18.                 For nData = 1 To oData.Count
    
19.                     nSum = nSum + Val(Replace(oData(nData - 1), "线上代扣", ""))
    
20.                 Next
    
21.             End If
    
22.             vFill(nRow, 1) = nSum
    
23.         Next
    
24.     End With
    
25.     [B2].Resize(UBound(vFill) - 1) = vFill
    
26. End Sub

复制代码

microyip

附上附件以供参考

lijian318

Yalishanda30 发表于 2019-3-18 15:32
试试看，不一定正确

解决了，谢谢1

lijian318

白薯beyond 发表于 2019-3-18 15:42
请见附件。

代码如下。第一次写正则代码，请路过的老师帮忙看看有哪些可以改进的地方，谢谢。

2018-10是对的，但是涉及到手工减免结清的，比如3月份的就有问题了