数据透视表分类求和后无法按大小排序

山芋1231

如附件，我按照年度求和了销售额，并添加字段计算了利润率，但是这样之后，针对某一年的销售额就没法排序了。若把添加的利润率字段去掉，销售额是可以排序的，但是把利润率再拉回来就不行，不知各位大神有没有好的方法可以按年汇总销售额，并计算出利润率？谢谢！（附件添加的数据源较少，真实的数据量较大，想不到用什么方法除了添加计算字段可以算出利润率）

3190496160

用vba来实现你目前透视表的效果就一切迎刃而解了，类似的帖子昨天回过一个，

q1579398897

直接排H列这样不行吗？

山芋1231

3190496160 发表于 2023-6-1 11:14
用vba来实现你目前透视表的效果就一切迎刃而解了，类似的帖子昨天回过一个，

看来是时候要学习VBA了

山芋1231

q1579398897 发表于 2023-6-1 11:34
直接排H列这样不行吗？

我主要是要L列或者R列排序，按照H列排序可能正好是数值的巧合啊，面对大量的数据肯定不行

3190496160

Sub 分类汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("明细")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "明细为空！": End
    ar = .Range("a1:e" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 2)) <> "" Then
        d(Trim(ar(i, 2))) = ""
    End If
Next i
ReDim br(1 To UBound(ar), 1 To 500)
k = 3
br(1, 2) = kk
br(3, 1) = "Row Labels"
With Sheets("分类汇总")
    .UsedRange = Empty
    For Each kk In d.keys
        For i = 2 To UBound(ar)
            If Trim(ar(i, 2)) = kk Then
                t = dc(Trim(ar(i, 1)))
                If t = "" Then
                    k = k + 1
                    dc(Trim(ar(i, 1))) = k
                    t = k
                    br(k, 1) = ar(i, 1)
                End If
                lh = dc(Trim(ar(i, 3)))
                If lh = "" Then
                    y = y + 2
                    dc(Trim(ar(i, 3))) = y
                    lh = y
                    br(1, y) = kk
                    br(2, y) = ar(i, 3)
                    br(3, y) = "Sum of 销售"
                    br(3, y + 1) = "Sum of 利润率"
                End If
                br(t, lh) = br(t, lh) + ar(i, 4)
                br(t, lh + 1) = br(t, lh + 1) + ar(i, 5)
            End If
        Next i
        For i = 2 To UBound(ar)
            If Trim(ar(i, 2)) = kk Then
                lh = dc(kk & "Sum of 销售")
                If lh = "" Then
                    y = y + 2
                    dc(kk & "Sum of 销售") = y
                    lh = y
                    br(3, y) = kk & "Sum of 销售"
                End If
                br(3, y + 1) = kk & "Sum of 利润率"
                t = dc(Trim(ar(i, 1)))
                br(t, lh) = br(t, lh) + ar(i, 4)
                br(t, lh + 1) = br(t, lh + 1) + ar(i, 5)
            End If
        Next i
    Next kk
    k = k + 1
    br(k, 1) = "Grand Total"
    For j = 2 To y + 1 Step 1
        For i = 4 To k - 1
            br(k, j) = br(k, j) + br(i, j)
        Next i
    Next j
    For j = 3 To y + 1 Step 2
        For i = 4 To k
            br(i, j) = br(i, j) / br(i, j - 1)
        Next i
    Next j
     .Cells(1, 1).Resize(k, y + 1) = br
     .Columns("a:bb").AutoFit
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

分类汇总后无法排序.rar (25.61 KB, 下载次数: 1)

2023-6-4 13:24 上传

点击文件名下载附件

仅供参考

山芋1231

3190496160 发表于 2023-6-4 13:24
仅供参考

谢谢大神，容我花时间学习研究一下