求助：如何改变表1为表2，然后在表3用数据透视表求和？

wxsc305

求求各位大神，在工作中经常遇到由表1转换成表2，然后根据表2在表3中用数据透视表求办公用品领用情况。谢谢各位大神帮助了！！！

3190496160

用vba可以一步到位，但是，不知道你最终结果表时啥样的

wxsc305

3190496160 发表于 2024-3-22 09:28
用vba可以一步到位，但是，不知道你最终结果表时啥样的

老师，我已更改表了，表2为部分内容的样式，表3为统计表，麻烦老师处理了，谢谢！！

3190496160

Sub 分类汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("表1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a2:aq" & r)
End With
ReDim br(1 To 50000, 1 To 100)
k = 1: y = 2
br(1, 1) = "物品名称"
br(1, 2) = "申请时间"
For i = 2 To UBound(ar)
    For j = 9 To 36 Step 3
        If ar(i, j) <> "" Then
            zd = ar(i, 8) & "|" & ar(i, j)
            t = d(zd)
            If t = "" Then
                k = k + 1
                d(zd) = k
                t = k
                br(k, 1) = ar(i, j)
                br(k, 2) = ar(i, 8)
                dc(br(k, 1)) = ""
            End If
            If ar(i, j + 1) <> "" Then
                lh = d(ar(i, j + 1))
                If lh = "" Then
                    y = y + 1
                    d(ar(i, j + 1)) = y
                    lh = y
                    br(1, y) = ar(i, j + 1)
                End If
            End If
            br(t, lh) = br(t, lh) + ar(i, j + 2)
        End If
    Next j
Next i
With Sheets("分类汇总")
    .UsedRange.Borders.LineStyle = 0
    .UsedRange = Empty
    .[a1].Resize(1, y) = br
    .Cells(1, y + 1) = "总计"
    For Each kc In dc.keys
        n = 0
        ReDim cr(1 To k, 1 To y + 1)
        For i = 2 To k
            If br(i, 1) = kc Then
                n = n + 1
                For j = 1 To y
                    cr(n, j) = br(i, j)
                    If j > 2 Then
                        If br(i, j) = "" Or Not IsNumeric(br(i, j)) Then
                            br(i, j) = 0
                        Else
                            br(i, j) = br(i, j)
                        End If
                        cr(n, y + 1) = cr(n, y + 1) + br(i, j)
                    End If
                Next j
            End If
        Next i
        rs = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(rs, 1).Resize(n, UBound(cr, 2)) = cr
        .Cells(rs + n, 1) = kc & " 汇总"
        For j = 3 To y
            .Cells(rs + n, j) = Application.Sum(Application.Index(cr, 0, j))
        Next j
    Next kc
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

办公用品领用申请表审批汇总统计 .rar (83.95 KB, 下载次数: 1)

2024-3-22 11:25 上传

点击文件名下载附件

3190496160

表1数据源用乱七八糟来形容毫不为过，所以，目前的代码仅供参考，要得到完美的结果，先规范你的数据源吧

wxsc305

3190496160 发表于 2024-3-22 11:26

老师，能不能先处理成表2的格式（分部门），即，提取每次申请的物品（每次最多可申请10种不同的物品）单独成行，如一次申请10种不同物品，那就转换成10行领用物品，这10行的部门由表2中M列的部门负责人确定为哪个部门，这样就可以根据需要按部门统计其中部分物品的领用时间及数量，分析实际消耗。