|
VIP学员的问题，要将摘要和金额按各种费用拆分到后面。实际有几百行数据，为了方便说明只截图10几行。 
摘要很乱，里面混合着很多无关的内容。比如电费一月500，一月这2个字就是无关的。停车费半年、停车费一年卡，半年、一年卡这些也是无关。还有租金之类后面还有日期2023.5.1，很容易把日期也提取进去。多种费用同时存在，等等。
一个字，乱！ 理论上这种表格是宣布无解的，不过在我的老乡24小时的不断测试，改了无数次代码，最后终于解决了。
让我们来一起见证这个牛逼的公式。
=FeiyongGuilei_Split($B2,D$1,$C2) 
最右边是我用公式验证结果，全部正确。
=IF(SUM(D2:I2)-C2=0,"正确","错误") 
公式看起来挺简单的，因为这是VBA自定义函数，核心还是背后的VBA代码。
开发工具，VB，模块，就看到这段很长的代码，一个界面截图不完，后面还有。
完整代码：
Function FeiyongGuilei_Split(Rng As Range, Gjz As String, Sz_CurRng As Range) As Currency Dim regEx As Object, CurRng As Range, Arr, Brr Dim Str As String, Reg_mat As Object, Reg_matF As Object Dim Sums As Currency, Sz_Cur As Currency Set regEx = CreateObject("VBScript.RegExp") Str = Rng.Value For Each CurRng In Sz_CurRng If CurRng <> 0 Then Sz_Cur = CurRng.Value Next CurRng With CreateObject("VBScript.RegExp") Rem 替换日期区间 .Pattern = "(\d{4}\.\d{1,2}\.\d{1,2}-\d{4}\.\d{1,2}\.\d{1,2})" Str = .Replace(Str, "") Str = Replace(Str, "（）", "") End With Arr = Split(Str, "，") For Each Brr In Arr If InStr(Brr, Gjz) > 0 Then Str = Mid(Brr, InStr(Brr, Gjz)) If IsNumeric(Right(Str, 1)) Then With regEx '提取规则 "(.)+\d+(\.\d+)?" .Pattern = "\d+(\.\d+)?" .Global = True '匹配所有满足的数据 Str = .Execute(Str)(0) Sums = Sums + NumRegex(Str) End With End If End If Next Brr FeiyongGuilei_Split = IIf(Sums = 0 And Str Like "*" & Gjz & "*", Sz_Cur, Sums)
End Function
Function NumRegex(Str As String) As String With CreateObject("VBScript.RegExp") .Pattern = "\d+(\.\d+)?" .Global = True NumRegex = .Execute(Str)(0) End WithEnd Function
|
