欢迎光临散文网 会员登陆 & 注册

ChatGPT和VBA的强强联合,改变你看待Excel的方式!

2023-07-26 21:18 作者:数字冠军RPA  | 我要投稿

完整代码如下:

Sub CreateGroupedBarChart()


  ' 检查 "分析" 工作表是否已存在,如果存在,则删除

  Dim ws As Worksheet

  For Each ws In ThisWorkbook.Sheets

    If ws.Name = "分析" Then

      Application.DisplayAlerts = False

      ws.Delete

      Application.DisplayAlerts = True

      Exit For

    End If

  Next ws

   

  ' 创建一个新的工作表"分析"

  Sheets.Add(After:=Sheets(Sheets.Count)).Name = "分析"


  ' 获取销售数据工作表

  Set ws = ThisWorkbook.Sheets("销售数据")


  ' 删除空白行

  Dim rng As Range

  Dim cell As Range

  Dim del As Range

  Set rng = Intersect(ws.Range("A1:A37"), ws.Range("A:A"))

  For Each cell In rng

    If (Trim(cell.Value) = "") Then

      If del Is Nothing Then

        Set del = cell

      Else

        Set del = Union(del, cell)

      End If

    End If

  Next cell

  On Error Resume Next

  del.EntireRow.Delete


  ' 将销售数据工作表中的数据复制到分析工作表

  ws.Range("A1:D37").Copy

  Sheets("分析").Range("A1").PasteSpecial Paste:=xlPasteValues

  Application.CutCopyMode = False


  ' 在分析工作表中插入数据透视表

  Dim pivotTable As pivotTable

  Dim PivotRange As Range

  Set PivotRange = Sheets("分析").Range("A1:D" & Sheets("分析").Cells(Rows.Count, 1).End(xlUp).Row)

  Sheets("分析").PivotTableWizard SourceType:=xlDatabase, SourceData:=PivotRange, _

    TableDestination:=Sheets("分析").Range("F5"), TableName:="PivotTable1"

   

  Set pivotTable = Sheets("分析").PivotTables("PivotTable1")

  pivotTable.PivotFields("电脑品牌").Orientation = xlRowField

  pivotTable.PivotFields("销售额").Orientation = xlDataField


  ' 刷新数据透视表的缓存

  pivotTable.PivotCache.Refresh


  ' 插入条形图

  Dim chartObj As ChartObject

  Set chartObj = Sheets("分析").ChartObjects.Add(Left:=200, Width:=375, Top:=50, Height:=225)

  chartObj.Chart.SetSourceData Source:=pivotTable.TableRange1

  chartObj.Chart.ChartType = xlBarClustered


  ' 格式化图表

  With chartObj.Chart

    .HasTitle = True

    .ChartTitle.Text = "电脑品牌销售额分组条形图"

    .Axes(xlCategory, xlPrimary).HasTitle = True

    .Axes(xlCategory, xlPrimary).AxisTitle.Text = "电脑品牌"

    .Axes(xlValue, xlPrimary).HasTitle = True

    .Axes(xlValue, xlPrimary).AxisTitle.Text = "销售额"

  End With

End Sub


ChatGPT和VBA的强强联合,改变你看待Excel的方式!的评论 (共 条)

分享到微博请遵守国家法律