直改横

xing_chen

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

老师!你这透视表中单号列，应该包含日期和单号。我现在临阵擦枪，再看透视表的知识

xing_chen

cjc209 发表于 2023-2-24 17:00
Sub 数据透视表vba法()
    Set 数据源区 = Sheet1.Range("A1").CurrentRegion
    Set 结果起始单元格 = ...

你真快呀！就这么会！我试试看

cjc209

xing_chen 发表于 2023-2-24 17:17
老师!你这透视表中单号列，应该包含日期和单号。我现在临阵擦枪，再看透视表的知识

什么意思?  

cjc209

xing_chen 发表于 2023-2-24 17:17
老师!你这透视表中单号列，应该包含日期和单号。我现在临阵擦枪，再看透视表的知识

看懂了 要这样就要构筑一列辅助列才能使用

xing_chen

cjc209 发表于 2023-2-24 17:20
什么意思?

我的意思是你透视表和代码，写的快，效率太高了。

cjc209

这样就达到你的奇葩要求了
Sub 数据透视表vba法()
   Dim arr
     Application.ScreenUpdating = False
    For i = 1 To Range("a" & Rows.Count).End(xlUp).Row
        Sheet1.Cells(i, 5) = Cells(i, 1) & " " & Cells(i, 2)
    Next
    Set 数据源区 = Sheet1.Range("A1").CurrentRegion
    Set 结果起始单元格 = Sheet1.Range("h1")
    arr = 数据源区 '原始数据区
    ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)

    行字段数组 = Array(arr(1, 3), arr(1, 5))
    列字段数组 = 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))
    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
    Sheet1.Columns(5).Clear
    结果起始单元格.Resize(UBound(brr), UBound(brr, 2)) = brr
    结果起始单元格.CurrentRegion.Borders.LineStyle = 1
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

cjc209

xing_chen 发表于 2023-2-24 17:34
我的意思是你透视表和代码，写的快，效率太高了。

数据透视表调用内存代码是模板式的 我存好了的 只是敲几个拼音代码 就会出来写好了的通用代码 根本不用去写
只是根据具体要求做小修改 和参数设置就好了 所以快 要善于收集通用代码 用时随手拿来就是秒秒钟之事

cjc209

不然写代码非常耗时 还要调试

cjc209

ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + 1) 这一句注释掉 没有用

zxsea_7426

初级代码: