ピボットテーブルのグループ分けのパーセンテージ範囲は、vbaを使用して

Question

私は、販売された製品の価格リストと先週からの価格の変更を行っていますが、パーセンテージの変更が計算されています。パーセント範囲。

グループ分けの助けが必要です。以下に示すように

Sub Part_I() 


'Group by 
Dim pf3 As PivotField 

Pvt2.RowAxisLayout xlTabularRow 
Set pf3 = Pvt2.PivotFields("% Premium Difference from Prior Term") 
pf3.LabelRange.Group Start:=-1, End:=1.2, By:=0.1 
pf3.Caption = "% Premium Difference from Prior Term2" 



Dim pi3   As PivotItem 
Dim sCaption3 As String 

Application.ScreenUpdating = False 


'Format so that groupings appear as percentage values 


For Each pi4 In pf3.PivotItems 

    sCaption3 = pi3.Caption & "0.0%" 
    sCaption3 = Replace$(sCaption3, "0.", "") 
    sCaption3 = Replace$(sCaption3, "-", " - ") 
    sCaption3 = Replace$(sCaption, "0%", "0.0%") 
    sCaption3 = Replace$(sCaption3, " - ", "0.0% - ") 
    sCaption3 = Replace$(sCaption3, "00.0%", "0.0%") 
    sCaption3 = Replace$(sCaption3, "<0.0%", "<") 
    sCaption3 = Replace$(sCaption3, "< - 10.0%", "-100.0% - 0.0%") 
    pi3.Caption = sCaption3 

Next pi4 

Application.ScreenUpdating = True 

Answer 1

わかりました、私はあなたがあなたのメインルーチンから呼び出すことができ、PercentGroupingsと呼ばれるparamatisedサブを作ってきました：

：あなたにこれを与える

Option Explicit 

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

Set pt = ActiveSheet.PivotTables("PivotTable1") '<= Change as appropriate 
Set pf = pt.PivotFields("Data") '<= 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 = " 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 


'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 & "%" 
     ElseIf InStr(.Caption, ">") > 0 Then 
      'Greater Than Group 
      .Caption = ">" & Split(.Caption, ">")(1) * 100 & "%" 
     Else 
      sCaption = "" 
      vSplit = Split(pi.Caption, "--") 
      If UBound(vSplit) = 1 Then 
       'Negative numbers 
       .Caption = vSplit(0) * 100 & "%" & sDelim & "-" & vSplit(1) * 100 & "%" 
      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) & "%" & sDelim & vSplit(1) & "%" 
      End If 
     End If 
    End With 
Next pi 

pf.Parent.ManualUpdate = False 

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

End Sub 

...