使用vba代码自定义数值分组

Question

我列出了所售产品的价格和上周的价格变化，现在我正在计算百分比变化，我正在编写vba代码来创建一个包含百分比范围分组的数据透视表。

在其他成员的帮助下，我可以达到10.0％的范围但是，我需要将代码修改为低于0.0％的百分比是一组（<0.0％），超过100.0％（＆gt; 100.0％）是一组，在它们之间，我需要有0.0％ - 9.9％和10.0％到19.9％的范围，依此类推。

我稍微改变了代码以满足我的需要（用“ - ”代替“to”）但我只添加了.0％所以现在范围显示为10.0％而不是10％但我仍然需要帮助改变方式我把他们分组。

 Option Explicit

Sub GroupPercents()
Dim pt As PivotTable
Dim pf As PivotField

Set pt = ActiveSheet.PivotTables("% Premium Difference") '<= Change as appropriate
Set pf = pt.PivotFields("% Premium Difference from Prior Term2") '<= Change as appropriate
PercentGroupings pf, -1, 1, 0.1
End Sub

Sub PercentGroupings(pf As PivotField, lFrom As Double, lTo As Double, lGroup As Double, Optional sDelim As String = " - ")

Dim pi          As PivotItem
Dim sCaption    As String
Dim vSplit      As Variant
Dim vItem       As Variant
Dim i           As Long


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With


On Error Resume Next
pf.LabelRange.Ungroup
On Error GoTo 0
pf.LabelRange.Group Start:=lFrom, End:=lTo, By:=lGroup
pf.Parent.ManualUpdate = True


'Format so that groupings appear as % values
For Each pi In pf.PivotItems
    With pi
        If InStr(.Caption, "<") > 0 Then
            'Less Than Group
            .Caption = "<" & Split(.Caption, "<")(1) * 100 & ".0%"
        ElseIf InStr(.Caption, ">") > 0 Then
            'Greater Than Group
            .Caption = ">" & Split(.Caption, ">")(1) * 100 & ".0%"
        Else
            sCaption = ""
            vSplit = Split(pi.Caption, "--")
            If UBound(vSplit) = 1 Then
                'Negative numbers
                .Caption = vSplit(0) * 100 & ".0%" & sDelim & "-" & vSplit(1) * 100 & ".0%"
            Else
                'Positive numbers
                vSplit = Split(pi.Caption, "-")
                If UBound(vSplit) = 1 Then
                    On Error Resume Next
                    vSplit(0) = vSplit(0) * 100
                    vSplit(1) = vSplit(1) * 100
                    On Error GoTo 0
                ElseIf UBound(vSplit) = 3 Then
                    ' There's some kind of bug with Excel's Grouping feature whereby
                    ' the zero grouping sometimes shows as scientific notation  e.g. -2.77555756156289E-17
                    ' So we'll test for this, and change it to zero
                    If IsNumeric(Join(Array(vSplit(2), vSplit(3)), "-")) Then
                        vSplit(0) = vSplit(1) * -100
                        vSplit(1) = 0
                    End If
                End If
                .Caption = vSplit(0) & ".0%" & sDelim & vSplit(1) & ".0%"
                End If
        End If
    End With
     sCaption = Replace$(sCaption, "to", sDelim)
Next pi

pf.Parent.ManualUpdate = False

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Answer 1

我还修改了代码，使其成为通用例程，以便您可以传入所需的数字格式。您现在可以指定不同的下限和上限，还可以传入一个名为dBreakPoint的可选参数，该参数可以减少每个分组的上限。

Sub PercentGroupings(pf As PivotField, _
                lFrom As Double, _
                lTo As Double, _
                lGroup As Double, _
                Optional vFormat As Variant, _
                Optional dBreakPoint As Double = 0, _
                Optional sDelim As String = " to ")

    Dim pi          As PivotItem
    Dim sCaption    As String
    Dim vSplit      As Variant
    Dim vItem       As Variant
    Dim i           As Long


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With


    On Error Resume Next
    pf.LabelRange.Ungroup
    On Error GoTo 0
    pf.LabelRange.Group Start:=lFrom, End:=lTo, By:=lGroup
    pf.Parent.ManualUpdate = True

    If IsMissing(vFormat) Then vFormat = pf.NumberFormat
    If vFormat = "General" Then vFormat = ""


    'Format so that groupings appear as % values
    For Each pi In pf.PivotItems
        With pi
            If InStr(.Caption, "<") > 0 Then
                'Less Than Group
                .Caption = "<" & Format(Split(.Caption, "<")(1), vFormat)
            ElseIf InStr(.Caption, ">") > 0 Then
                'Greater Than Group
                .Caption = ">" & Format(Split(.Caption, ">")(1), vFormat)
            Else
                sCaption = ""
                vSplit = Split(pi.Caption, "--")
                If UBound(vSplit) = 1 Then
                    'Negative numbers
                    .Caption = Format(vSplit(0), vFormat) & sDelim & "-" & Format(vSplit(1) - dBreakPoint, vFormat)
                Else
                    'Positive numbers
                    vSplit = Split(pi.Caption, "-")
                    Select Case UBound(vSplit)
                    Case 2
                        'Grouping spans zero
                        vSplit(0) = -vSplit(1)
                        vSplit(1) = vSplit(2)
                    Case 3
                        ' There's some kind of bug with Excel's Grouping feature whereby
                        ' the zero grouping sometimes shows as scientific notation  e.g. -2.77555756156289E-17
                        ' So we'll test for this, and change it to zero
                        If IsNumeric(Join(Array(vSplit(2), vSplit(3)), "-")) Then
                            vSplit(0) = -vSplit(1)
                            vSplit(1) = 0
                        End If
                    End Select
                    .Caption = Format(vSplit(0), vFormat) & sDelim & Format(vSplit(1) - dBreakPoint, vFormat)
                    End If
            End If
        End With
         sCaption = Replace$(sCaption, "to", sDelim)
    Next pi

    pf.Parent.ManualUpdate = False

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    End Sub

你这样称呼它：

Sub FormatPivotGroups()

Dim pf As PivotField

Set pf = ActiveSheet.PivotTables("PivotTable3").PivotFields("Price Difference") '<= Change as appropriate
PercentGroupings pf, -1, 1, 0.1, "0%"
End Sub

...有这个结果：

如果要设置较高范围以使其小于下一个可能分组的较低范围，请使用以下内容：

PercentGroupings pf, -1, 1, 0.1, "0%", 0.001

......具有这种效果：

如果你想将0以下的任何东西组合在一起，你只需要将第一个参数从-1改为0：

PercentGroupings pf, 0, 1, 0.1, "0%", 0.001

...有这个结果：

如果您想使用短划线（或其他任何东西）作为分隔符而不是默认单词＆＃34;到＆＃34;然后你会这样称呼它：

PercentGroupings pf, 0, 1, 0.1, "0%", 0.001, " - "

......会产生这种影响：

您也可以更改应用的格式。因此，如果您希望这些数字显示为美元和99美分宽的乐队，那么您可以这样称呼它：

PercentGroupings pf, 0, 1, 0.1, "$0.00", 0.01, " - "

...有这个结果：