直改横

xing_chen

老师，有表，需将原日期直排的金额重按照横排的月份归类填写。敬请老师赐教。谢谢！

cjc209

数据透视表 应该可以吗?

ykcbf1100

快下班了，让别的老师来吧。

xing_chen

cjc209 发表于 2023-2-24 16:47
数据透视表 应该可以吗?

可以呀！不过我不熟悉透视表，但我希望用代码写成的，老师可以帮忙吗？

cjc209

数据透视表样式

cjc209

xing_chen 发表于 2023-2-24 16:49
可以呀！不过我不熟悉透视表，但我希望用代码写成的，老师可以帮忙吗？

可以啊 也很简单

cjc209

Sub 数据透视表vba法()
    Set 数据源区 = Sheet1.Range("A1").CurrentRegion
    Set 结果起始单元格 = Sheet1.Range("h1")
    arr = 数据源区 '原始数据区
   
    行字段数组 = Array(arr(1, 3), arr(1, 2))
    列字段数组 = Array(arr(1, 1)) 'Array(arr(1, 3), arr(1, 6))  非数组都视为没有列字段
    值字段数组 = Array(arr(1, 4))
    汇总函数数组 = Array(xlSum) '一定要与值字段相匹配
    横向分类汇总 = False 'True 或者 1 开启分类汇总合计 False 或者 0 不开启
    纵向分类汇总 = 1 'True 或者 1 开启分类汇总合计 False 或者 0 不开启
    横向总合计 = 1 'False 或者 0 不要行方向合计 True 或者 1 为开启合计
    纵向总合计 = 1 'False 或者 0 不要列方向合计 True 或者 1 为开启合计
    重复标签 = 1 'False 或者 0 不重复标签 True 或者 1 为开启重复标签
   
   
    Application.DisplayAlerts = False
    Set 缓存 = ThisWorkbook.PivotCaches.Create(xlDatabase, 数据源区.Address(External:=True))
    '在H1单元格做透视表
    Set Pi = 缓存.CreatePivotTable(结果起始单元格)
    With Pi
        If IsArray(列字段数组) Then
            .AddFields RowFields:=行字段数组, ColumnFields:=列字段数组 'RowFields行字段 ColumnFields列字段 PageFields筛选字段
        Else
            .AddFields RowFields:=行字段数组
        End If
        For i = 0 To UBound(值字段数组)
            .AddDataField .PivotFields(值字段数组(i)), , 汇总函数数组(i) '求值
        Next
        '显示透视表的形式
        '        .RowAxisLayout xlOutlineRo '大纲型
        .RowAxisLayout xlTabularRow '表格型
        If 重复标签 Then
            .RepeatAllLabels xlRepeatLabels
        End If
        .RowGrand = 横向总合计 '不要行方向合计
        .ColumnGrand = 纵向总合计 '不要列方向合计
        If IsArray(行字段数组) Then
            For i = 0 To UBound(行字段数组) - 1
                .PivotFields(行字段数组(i)).Subtotals(1) = 纵向分类汇总
            Next
        End If
        If IsArray(列字段数组) Then
            For i = 0 To UBound(列字段数组) - 1
                .PivotFields(列字段数组(i)).Subtotals(1) = 横向分类汇总
            Next
        End If
    End With
    brr = 结果起始单元格.CurrentRegion
    结果起始单元格.CurrentRegion.Clear
    结果起始单元格.Resize(UBound(brr), UBound(brr, 2)) = brr
    结果起始单元格.CurrentRegion.Borders.LineStyle = 1
    Application.DisplayAlerts = True
End Sub

cjc209

这是通用型的 只是按需求修改参数就行了 主体不动

xing_chen

ykcbf1100 发表于 2023-2-24 16:48
快下班了，让别的老师来吧。

谢谢!下班了！可以放松啦！周末快乐

xing_chen

cjc209 发表于 2023-2-24 16:51
可以啊 也很简单

谢谢老师!我学习一下透视表!可以帮忙写个代码吗！