根据比例提成

jjip123

根据提成比例，求提成 ，大概800多个人，用公式的话慢的很，请大神弄一个代码，能单击一下就生成提成，谢谢，这个上面只是到80000，实际上有可能 收入上十几二十万，提成按2%递增。谢谢各位大神！！！

一把小刀闯天下

Option Explicit

Sub test()
  Dim i, arr, brr, j, pos
  arr = [f1].CurrentRegion: brr = [a1].CurrentRegion
  arr(2, 2) = 0.2
  For i = 3 To UBound(arr, 2): arr(2, i) = arr(2, i - 1) + 0.02: Next
  For j = 2 To UBound(arr, 2)
    For i = 3 To UBound(arr, 1)
      arr(i, j) = arr(i - 1, j) + 0.02
  Next i, j
  For i = 2 To UBound(brr, 1)
    For j = 2 To UBound(arr, 1)
      If InStr(brr(i, 2), arr(j, 1)) Then pos = j: Exit For '"置业顾问"应该为"顾问"？只能用instr匹配来
    Next
    If j < UBound(arr, 1) + 1 Then
      If brr(i, 3) < arr(1, 2) Then
        brr(i, 1) = 0
      Else
        For j = 3 To UBound(arr, 2)
          If brr(i, 3) < arr(1, j) Then brr(i, 1) = brr(i, 3) * arr(pos, j - 1): Exit For
        Next
        If j = UBound(arr, 2) + 1 Then brr(i, 1) = "级别太高无法匹配！"
      End If
    Else
      brr(i, 1) = "无此级别！"
    End If
  Next
  With [d1]
    .Resize(UBound(brr, 1)) = brr
    .Value = "提成"
  End With
End Sub

vbee

800多个人公式可以了

1. =IF(C2<10000,0,(INT(C2/10000)*2%+VLOOKUP(B2,{"置业顾问",0.18;"高级",0.2;"资深",0.22},2,0))*C2)

复制代码

jjip123

一把小刀闯天下 发表于 2018-6-20 12:17
Option Explicit

Sub test()

一把小刀闯天下

jjip123 发表于 2018-6-20 12:33

上限有你确定，最高多少？我给你定个上限1亿如何？

或者上附件。

jjip123

一把小刀闯天下 发表于 2018-6-20 12:39
上限有你确定，最高多少？我给你定个上限1亿如何？

或者上附件。

上限500万

jjip123

vbee 发表于 2018-6-20 12:22
800多个人公式可以了

谢谢，很强大

lsdongjh

如果职级差是规律的，就非常简单，确实如3楼所说。如果不规律，需要逐列找到最大匹配，然后找到对应职级行，并不难。

一把小刀闯天下

'不封顶本身就有问题，根本没有实用价值，稍作修改。

Option Explicit

Sub test()
  Dim i, arr, brr, j, pos
  arr = Range("f1:iv" & Cells(Rows.Count, "f").End(xlUp).Row)
  brr = [a1].CurrentRegion
  arr(1, 2) = 10 ^ 4: arr(2, 2) = 0.2
  For i = 3 To UBound(arr, 2): arr(1, i) = arr(1, 2) * (i - 1): Next
  For i = 3 To UBound(arr, 2): arr(2, i) = arr(2, i - 1) + 0.02: Next
  For j = 2 To UBound(arr, 2)
    For i = 3 To UBound(arr, 1)
      arr(i, j) = arr(i - 1, j) + 0.02
  Next i, j
  For i = 2 To UBound(brr, 1)
    For j = 2 To UBound(arr, 1)
      If InStr(brr(i, 2), arr(j, 1)) Then pos = j: Exit For '"置业顾问"应该为"顾问"？只能用instr匹配来
    Next
    If j < UBound(arr, 1) + 1 Then
      If brr(i, 3) < arr(1, 2) Then
        brr(i, 1) = 0
      Else
        For j = 3 To UBound(arr, 2)
          If brr(i, 3) < arr(1, j) Then brr(i, 1) = brr(i, 3) * arr(pos, j - 1): Exit For
        Next
        If j = UBound(arr, 2) + 1 Then brr(i, 1) = "级别太高无法匹配！"
      End If
    Else
      brr(i, 1) = "无此级别！"
    End If
  Next
  With [d1]
    .Resize(UBound(brr, 1)) = brr
    .Value = "提成"
  End With
End Sub

jjip123

一把小刀闯天下 发表于 2018-6-20 15:35
'不封顶本身就有问题，根本没有实用价值，稍作修改。

Option Explicit

谢谢！！！