[已解决]返利目标

nancy66317

各位前辈，大家好！小妹遇到一个难道，希望得到大家帮助！
问题是这样的，最近在统计客户返利，表格如下 返利目标.rar (7.61 KB, 下载次数: 8)

2011-11-10 10:42 上传

点击文件名下载附件 ，请各位帮忙用VBA判断填写D和E列。

最佳答案

月排行榜 / 总排行榜

liuguansky

2011-11-10 17:13

nancy66317 发表于 2011-11-10 12:43
这是一个加了数据的表

依沟通后结果及附件：

1. Function Mb(Rn As Range, RnX As Range, Optional k As Boolean = False) As Variant
   
2.     Application.Volatile
   
3.     Dim m, i As Byte, t As Long, s$
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(^|[，；])(\d+)"
   
7.         s = Mid(Rn.Value, 6)
   
8.         If .test(s) Then
   
9.             For Each m In .Execute(s)
   
10.                 i = i + 1: t = CLng(m.submatches(1))
    
11.                 If t >= RnX.Value * 0.0001 Then
    
12. 100
    
13.                     If k Then
    
14.                         Mb = Format(RnX.Value / t / 10000, "0.00%")
    
15.                     Else
    
16.                         Mb = "目标" & i
    
17.                     End If
    
18.                     Exit Function
    
19.                 End If
    
20.             Next
    
21.             If Len(Mb) = 0 Then GoTo 100
    
22.         End If
    
23.     End With
    
24. End Function
    

复制代码

表格公式同上。
返利目标（3）.rar (9.51 KB, 下载次数: 28)

2011-11-10 17:13 上传

点击文件名下载附件

跳转到最佳答案楼层

那么的帅

示例少了一些，请多提供写数据示例。

liuguansky

1. Function Mb(Rn As Range, RnX As Range, Optional k As Boolean = False) As Variant
   
2.     Application.Volatile
   
3.     Dim m, i As Byte, t As Long
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(^|，)(\d+)"
   
7.         If .test(Rn.Value) Then
   
8.             For Each m In .Execute(Rn.Value)
   
9.                 i = i + 1: t = CLng(m.submatches(1))
   
10.                 If t >= RnX.Value * 0.0001 Then
    
11.                     If k Then
    
12.                         Mb = Format(RnX.Value / t / 10000, "0.00%")
    
13.                     Else
    
14.                         Mb = "目标" & i
    
15.                     End If
    
16.                     Exit For
    
17.                 End If
    
18.             Next
    
19.         End If
    
20.     End With
    
21. End Function
    

复制代码

返利目标.rar (13.24 KB, 下载次数: 3)

2011-11-10 11:24 上传

点击文件名下载附件
试下这个自定义函数
D2

1. =mb(B2,C2,0)

复制代码

e2

1. 
   
2. =mb(B2,C2,1)
   

复制代码

nancy66317

感觉有点不稳定，修改了数据，就变成0了，想请问一下代码的含义

nancy66317

liuguansky 发表于 2011-11-10 11:24
试下这个自定义函数
D2
e2

你好，请问一下这段代码是什么意思呢？
With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "(^|，)(\d+)"
        If .test(Rn.Value) Then
            For Each m In .Execute(Rn.Value)
                i = i + 1: t = CLng(m.submatches(1))
                If t >= RnX.Value * 0.0001 Then

nancy66317

liuguansky 发表于 2011-11-10 11:24
试下这个自定义函数
D2
e2

这是一个加了数据的表 返利目标（1）.rar (13.67 KB, 下载次数: 12)

2011-11-10 12:43 上传

点击文件名下载附件

liuguansky

nancy66317 发表于 2011-11-10 12:43
这是一个加了数据的表

依沟通后结果及附件：

1. Function Mb(Rn As Range, RnX As Range, Optional k As Boolean = False) As Variant
   
2.     Application.Volatile
   
3.     Dim m, i As Byte, t As Long, s$
   
4.     With CreateObject("vbscript.regexp")
   
5.         .Global = True
   
6.         .Pattern = "(^|[，；])(\d+)"
   
7.         s = Mid(Rn.Value, 6)
   
8.         If .test(s) Then
   
9.             For Each m In .Execute(s)
   
10.                 i = i + 1: t = CLng(m.submatches(1))
    
11.                 If t >= RnX.Value * 0.0001 Then
    
12. 100
    
13.                     If k Then
    
14.                         Mb = Format(RnX.Value / t / 10000, "0.00%")
    
15.                     Else
    
16.                         Mb = "目标" & i
    
17.                     End If
    
18.                     Exit Function
    
19.                 End If
    
20.             Next
    
21.             If Len(Mb) = 0 Then GoTo 100
    
22.         End If
    
23.     End With
    
24. End Function
    

复制代码

表格公式同上。
返利目标（3）.rar (9.51 KB, 下载次数: 28)

2011-11-10 17:13 上传

点击文件名下载附件

nancy66317

谢谢，liuguansky 太热心了！