Sub 数据分析()
Dim wb As Workbook
Dim wsCurrent As Worksheet, wsAnalyse As Worksheet
Dim pvtCache As PivotCache
Dim pvtTable As PivotTable
' 设置相关对象
Set wb = ThisWorkbook
Set wsCurrent = ActiveSheet
' 检查是否存在名为 "analyse" 的工作表
On Error Resume Next
Set wsAnalyse = wb.Worksheets("analyse")
If Not wsAnalyse Is Nothing Then
Application.DisplayAlerts = False
wsAnalyse.Delete
Application.DisplayAlerts = True
End If
On Error GoTo 0
' 创建新的 "analyse" 工作表
Set wsAnalyse = wb.Worksheets.Add
wsAnalyse.Name = "analyse"
' 创建数据透析缓存
Set pvtCache = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=wsCurrent.UsedRange)
' 在新工作表创建透析项
Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=wsAnalyse.Range("A3"), TableName:="PivotTable1")
' 设置行字段，列字段和值字段
With pvtTable
With .PivotFields(wsCurrent.Cells(1, 5).Value) '取 E 列的列头名称作为行字段
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields(wsCurrent.Cells(1, 6).Value) '取 F 列的列头名称作为值字段
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
End With
With .PivotFields(wsCurrent.Cells(1, 7).Value) '取 G 列的列头名称作为值字段
.Orientation = xlDataField
.Function = xlSum
.Position = 2
.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
End With
End With
MsgBox "数据分析完成"
End Sub