快速统计员工所选菜品的合计金额

AICON1314

1.公司有10个车间

2.每个车间有10-15个小组（每个车间小组数量不一致）

3.每个组有10-20名员工（每个组员工数量不一致）

4.每个员工（可能出现重名）可选1-5个菜品（每个员工选择的菜品不一致）

5.每个菜品的价格不固定，没有规律

要求：快速汇总每个车间，每个组，每个员工，所选的菜品（菜品价格对应的菜品），并且计算出每个员工所选菜品的合计金额

求各位大神指导，附件详见：员工配餐金额统计表.zip

orr89

无需怀疑,就是用字典鼓捣

AICON1314

orr89 发表于 2020-11-28 11:59
无需怀疑,就是用字典鼓捣

研究了好久也没弄出来

笨鸟飞不高

Sub AwTest()
    Dim i&, j%, x&, r&, y%, s, xmStr$, ws As Worksheet
    Dim arr, brr(1 To 5000, 1 To 14), d As Object
    Set d = CreateObject("Scripting.Dictionary")
    Sheet1.Activate
    For Each ws In Sheets
        If ws.Name <> ActiveSheet.Name Then
            arr = ws.Range("A1:M" & ws.Cells(Rows.Count, 1).End(3).Row)
            For i = 2 To UBound(arr)
                If Len(arr(i, 1)) Then
                    xmStr = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
                    For j = 4 To UBound(arr, 2)
                        x = d(xmStr): y = d(xmStr & "|c")
                        If arr(i, j) > 0 Then
                            If x = 0 Then r = r + 1: d(xmStr) = r: brr(r, 1) = arr(i, 1): _
                                brr(r, 2) = arr(i, 2): brr(r, 3) = arr(i, 3): x = r
                            If y = 0 Then y = 4: d(xmStr & "|c") = y
                            brr(x, y) = arr(1, j)
                            brr(x, y + 5) = arr(i, j)
                            d(xmStr & "|c") = d(xmStr & "|c") + 1
                            s = s + arr(i, j)
                        End If
                    Next
                    If x > 0 Then brr(x, UBound(brr, 2)) = s: s = 0
                End If
            Next
        End If
    Next
    [a2:n5000].ClearContents
    [a2].Resize(r, 14) = brr
End Sub

笨鸟飞不高

第一车间-员工配餐金额统计表.zip (33.11 KB, 下载次数: 13)

2020-11-28 12:52 上传

点击文件名下载附件

AICON1314

笨鸟飞不高 发表于 2020-11-28 12:50
Sub AwTest()
    Dim i&, j%, x&, r&, y%, s, xmStr$, ws As Worksheet
    Dim arr, brr(1 To 5000, 1  ...