如何使用Excel VBA宏以季度而不是月份获取数据

我用VBA创建了一个宏，并创建了一个月表。请参见下面的代码

Private Sub CommandButton1_Click()
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Chart'!$A$1:$L$2")
ActiveChart.ChartType = xlLineStacked
Dim cht As Chart
Dim ser As Series
Set cht = ActiveChart
Set ser = cht.SeriesCollection(1)
cht.Parent.Width = 227
cht.Parent.Height = 200
ser.Format.Line.Visible = msoFalse
ser.Format.Line.Visible = msoTrue
ser.Format.Line.ForeColor.RGB = RGB(26, 46, 74)
ser.Format.Fill.ForeColor.RGB = RGB(26, 46, 74)
With Worksheets("Chart").ChartObjects(1).Chart
.HasTitle = True
.ChartTitle.Text = Sheets("Chart").Range("B10")
.ChartTitle.Font.Size = 12
.ChartTitle.Font.Color = RGB(26, 46, 74)
End With
With cht.PlotArea.Format.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(239, 239, 239)
    .Transparency = 0
    .Solid
   End With
 With cht.ChartArea.Fill
.Visible = True
.ForeColor.SchemeColor = 15
.BackColor.SchemeColor = 15
.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1
End With
Dim co As ChartObject
For Each co In ActiveSheet.ChartObjects
co.Chart.ChartArea.Format.Fill.Visible = msoFalse
co.Chart.PlotArea.Format.Fill.Visible = msoFalse
Next
Dim Srs As Series
Set Srs = ActiveChart.SeriesCollection(1)
Srs.Name = ""
Dim ChartObj As Object
For Each ChartObj In Sheets("Chart").ChartObjects
ChartObj.Chart.Location xlLocationAsObject, "Factsheet"
With ActiveSheet
.ChartObjects(1).Top = .Range("D8").Top
.ChartObjects(1).Left = .Range("D8").Left
End With
Next ChartObj
End Sub

如何使用季度数据创建图表，以代替显示月份，它将显示第一季度、第二季度、第三季度和第四季度

这是否可以用VBA创建

---

提前感谢。

将数据汇总到季度的最佳方法是插入数据透视表，并通过右键单击任何日期值来使用“组”功能

编辑1 回应@Anahit DEV的评论。没有源代码就很难编写任何代码。但是，下一个宏将帮助您实现目标。请注意，我为您写了一些注释，您必须在需要时替换这些值

Sub CreatePivotTable()
'PURPOSE: Creates a brand new Pivot table on a new worksheet from data in the ActiveSheet
'Source: www.TheSpreadsheetGuru.com
'Modified by Dani Aya on 25/03/2016

Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
Dim celda As Range
Dim adrs_date_cell As String
Dim adrs_src_table As String 'address of source table

'you must select the worksheet where the data source table is and then run this macro
adrs_src_table = ActiveSheet.Range("A2").CurrentRegion.Address '<--- assuming second cell in the table is A2

'Determine the data range you want to pivot

  SrcData = ActiveSheet.Name & "!" & Range(adrs_src_table).Address(ReferenceStyle:=xlR1C1)

'Create a new worksheet
  Set sht = Sheets.Add
  sht.Name = "PT2"

'Where do you want Pivot Table to start?
  StartPvt = "PT2!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

'Create Pivot Cache from Source Data
  Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SrcData)

'Create Pivot table from Pivot Cache
  Set pvt = pvtCache.CreatePivotTable( _
    TableDestination:=StartPvt, _
    TableName:="QuartersPivotTable1")


'turn on dates in pivot table. Next segment of code insert two row labels (it's means two name columns) and one count value

    'inserting firs row label from the pivot field lists
    With ActiveSheet.PivotTables("QuartersPivotTable1").PivotFields( _
        "date") '<----- place here a valid field date name from your table
        .Orientation = xlRowField
        .Position = 1
    End With
    'inserting one count value from the pivot field list
    ActiveSheet.PivotTables("QuartersPivotTable1").AddDataField ActiveSheet. _
        PivotTables("QuartersPivotTable1")
        .PivotFields ("any_field"), "#", xlCount '<----- Place your field to count rows from table instead if "any_field"
    'inserting second row label from the pivot field list
    With ActiveSheet.PivotTables("QuartersPivotTable1").PivotFields("another_field") '<----- place here another field name from your table.
        .Orientation = xlRowField
        .Position = 2
    End With


'group your dates by quarters
    '1. Search any date value
    For Each celda In ActiveSheet.Range("A1:A1048576")
        If IsDate(celda.Value) Then
            'get address where a date value were found
            adrs_date_cell = celda.Address
            Exit For
        End If
    Next celda
    '2. Group by quarters selecting a valid date
    ActiveSheet.Range(adrs_date_cell).Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, True)
End Sub

Sub-CreatePivotTable（）
'目的：根据ActiveSheet中的数据在新工作表上创建一个全新的透视表
来源：www.TheSpreadsheetGuru.com
“由Dani Aya于2016年3月25日修改
将sht变暗为工作表
将pvtCache设置为数据透视缓存
将pvt设置为数据透视表
作为字符串的Dim StartPvt
将数据设置为字符串
暗淡的塞尔达山脉
Dim adrs\U date\U单元格作为字符串
Dim adrs_src_表作为源表的字符串地址
'必须选择数据源表所在的工作表，然后运行此宏
adrs_src_table=ActiveSheet.Range（“A2”）.CurrentRegion.Address'但我需要使用VBA代码自动完成这项工作，而不是手动@Dani Aya。您可以从VBA代码创建透视表。请参阅下一个链接：那么我的代码将是什么样子？你能帮帮我吗@Dani Aya？