通过vba创建一个Excel交叉表,并优化
2024-12-04 17:58阅读：
'创建一个符合格式的透视表,字段是表格形式标签,重复标签,标签融合居中
Sub CreatePivotTable()
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim sht As Worksheet
Dim shtPivot As Worksheet
'设置数据源所在的工作表
Set sht = ThisWorkbook.Worksheets('站点汇总数据')
Set shtPivot =
ThisWorkbook.Worksheets('市区统计')
'创建数据透视表缓存
Set PvtCache =
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase,
SourceData:=sht.Cells(1).CurrentRegion)
'基于缓存创建数据透视表
Set PvtTbl =
PvtCache.CreatePivotTable(shtPivot.Cells(1))
' Set PvtTbl =
PvtCache.CreatePivotTable(TableDestination:=shtPivot.Range('A1'),
TableName:='PivotTable1')
'以下是添加字段到透视表各区域的示例，你根据实际数据和需求调整字段名称
PvtTbl.PivotFields('供服中心').Orientation = xlRowField
'将'字段1'添加到行区域
PvtTbl.PivotFields('抄表员').Orientation = xlRowField
'将'字段1'添加到行区域
PvtTbl.PivotFields('抄表方式').Orientation =
xlColumnField '将'字段2'添加到列区域
PvtTbl.AddDataField PvtTbl.PivotFields('电量合计'),
'电量合计', xlSum
'将'求和项:字段3'添加到数据区域，这里假设对字段3进行求和，若要其他计算类型可修改函数
'PvtTbl.AddDataField PvtTbl.PivotFields('电量合计'),
'电量条数', xlCount
'将'求和项:字段3'添加到数据区域，这里假设对字段3进行求和，若要其他计算类型可修改函数
'
ActiveSheet.PivotTables('PivotTable1').AddDataField
ActiveSheet.PivotTables('PivotTable1').PivotFields('电量合计'),
'求和项:电量合计', xlSum
' With
ActiveSheet.PivotTables('PivotTable1').PivotFields('求和项:电量合计')
' .Caption = '计数项:电量合计'
' .Function = xlCount
' End With
End Sub
Sub 透视表美化()
Dim PvtTbl
Set PvtTbl = ActiveSheet.PivotTables(1)
'透视表选项,布局:合并居中标签
PvtTbl.MergeLabels = True
'选择透视表布局是大纲\压缩\表格
'
PvtTbl.RowAxisLayout xlCompactRow'报表布局:压缩
'
PvtTbl.RowAxisLayout xlOutlineRow'报表布局:大纲
PvtTbl.RowAxisLayout xlTabularRow
'报表布局:表格...表格的行轴布局,Axis是轴,Tabular是表格相关的意思
PvtTbl.RepeatAllLabels
xlRepeatLabels '重复所有项目标签(填满空格)
'风格美化,加粗行列等
PvtTbl.ShowTableStyleColumnStripes = True '镶边列
PvtTbl.ShowTableStyleColumnHeaders = True '列标题加粗
PvtTbl.ShowTableStyleRowHeaders = True '行标题加粗,
PvtTbl.TableStyle2 =
'TableStyleMedium2' '设置一个透视表风格,配色
'是否要总计行列
PvtTbl.RowGrand = False '
取消行总计
PvtTbl.ColumnGrand = False
'取消列总计
'列顺序调整,
PvtTbl.PivotFields('抄表方式').PivotItems('远红外抄表器').Position = 1
End Sub
'对每个字段应用表格布局,效率太低
'For Each pp In PvtTbl.PivotFields
'If pp.Orientation = xlRowField Then
'如果字段方向是行字段,则设置字段布局为表格形式
'pp.LayoutForm = xlTabular
'表格形式而不是大纲
'pp.RepeatLabels = True
'重复标签'居中合并的时候不可用
'End If
'Next
' PvtTbl.PivotFields('核算员').LayoutForm = xlTabular
'用表格形式,xlOutline是用大纲的形式
' PvtTbl.PivotFields('供服中心').LayoutForm = xlTabular
'用表格形式,xlOutline是用大纲的形式
''PvtTbl.PivotFields('核算员').Subtotals = Array(False, False, False,
False, False, False, False, False, False, False, False,
False)
