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

lj3543711

如何通过VBA如图统计这样的销售提成呢，大神请留下脚印

附件已上传
计算提成.zip (23.92 KB, 下载次数: 1)

2022-6-24 14:07 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

釜底抽薪

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

跳转到最佳答案楼层

釜底抽薪

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

lj3543711

釜底抽薪 发表于 2022-6-24 15:51
Private Sub CommandButton1_Click()
    Dim d As New Dictionary
    Dim ar, br

大神可以去掉 没有提成的商品不？

釜底抽薪

lj3543711 发表于 2022-6-24 16:41
大神可以去掉 没有提成的商品不？

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

2022-6-25 22:44 上传

点击文件名下载附件