Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 67|回复: 3

[已解决]如何通过VBA如图统计这样的销售提成呢,大神请留下脚印

[复制链接]
发表于 2022-6-24 14:07 | 显示全部楼层 |阅读模式
如何通过VBA如图统计这样的销售提成呢,大神请留下脚印
1.png 2.png 3.png
附件已上传
计算提成.zip (23.92 KB, 下载次数: 1)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2022-6-24 15:51 | 显示全部楼层    本楼为最佳答案   
Private Sub CommandButton1_Click()
    Dim d As New Dictionary
    Dim ar, br
    Dim i As Integer
    With Sheet1
        ar = .Range("a2:d" & .[a65536].End(xlUp).Row)
    End With
    For i = LBound(ar) To UBound(ar)
        If Not d.Exists(ar(i, 1)) Then d(ar(i, 1)) = ar(i, 3)
    Next i
    Erase ar
    With Sheet3
        br = .Range("a2:N" & .[a65536].End(xlUp).Row)
    End With
    ReDim ar(1 To UBound(br), 1 To 11)
    For i = LBound(br) To UBound(br)
        ar(i, 1) = ""
        ar(i, 2) = br(i, 2)
        ar(i, 3) = br(i, 1)
        ar(i, 4) = br(i, 3)
        ar(i, 5) = br(i, 4)
        ar(i, 6) = br(i, 5)
        ar(i, 7) = br(i, 6)
        ar(i, 8) = br(i, 12)
        If d.Exists(ar(i, 6)) Then
            ar(i, 9) = d.Item(ar(i, 6)) * ar(i, 8)
            ar(i, 10) = Round(ar(i, 9), 0)
        Else
            ar(i, 9) = ""
            ar(i, 10) = ""
        End If
    Next i
    Sheet2.[a2].Resize(UBound(ar), UBound(ar, 2)) = ar
    Columns.AutoFit
    Rows.AutoFit
    Set d = Nothing
End Sub

计算提成.zip

33.75 KB, 下载次数: 4

回复

使用道具 举报

 楼主| 发表于 2022-6-24 16:41 | 显示全部楼层
釜底抽薪 发表于 2022-6-24 15:51
Private Sub CommandButton1_Click()
    Dim d As New Dictionary
    Dim ar, br

大神可以去掉 没有提成的商品不?
回复

使用道具 举报

发表于 2022-6-25 22:44 | 显示全部楼层
lj3543711 发表于 2022-6-24 16:41
大神可以去掉 没有提成的商品不?

1计算提成.zip (32.42 KB, 下载次数: 0)
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2022-6-30 09:31 , Processed in 0.164203 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表