【VBA研究】用VBA创建数据透视表

作者：iamlaosong

有个拣货报表，想先从货品信息中分离出颜色信息，再根据储位、名称和颜色创建一个数据透视表，由于数据是变化的（结构不变，记录数会变），每次重新创建很麻烦，因此想做个工具，用VBA分离颜色并创建数据透视表，供其他人使用。分离颜色的代码很好写，创建数据透视表的代码自然采用录制宏的方法最简单，代码出来后修改一下就行了。

1、工具界面如下：

2、拣货单的内容如下，需要分离SKU信息中的颜色：

3、工具的代码如下：

'分离信息
Sub separate_information()
    
    On Error GoTo Err
    thisfile = ThisWorkbook.name   '本文件的名字，这样赋值就可以随便改名了
    Worksheets("系统参数").Select
    If Cells(2, 2) = "Y" Or Cells(2, 2) = "y" Then                              '导出出库文件
        Application.ScreenUpdating = True
    Else
        Application.ScreenUpdating = False
    End If
    
    'curdate = Cells(2, 2)
    'pos_qsh = Cells(2, 7)
    'pos_sku = Asc(Cells(3, 7)) - 64
    pos_fst = Cells(2, 7)
    pos_sku = Cells(3, 7)
    pos_sav = Cells(4, 7)
    pos_tag = Cells(5, 7)
    pos_end = Cells(6, 7)
    
    'If MsgBox("开始生成清分数据......", vbOKCancel, "iamlaosong") = vbCancel Then Exit Sub
    
    lineno = [A65536].End(xlUp).Row           '行数，文件数量
    
    For unit_num = 5 To lineno                 '文件循环
    
        datfile = Cells(unit_num, 2)                              '文件名称
        datFullName = ThisWorkbook.Path & "\" & datfile
        If Dir(datFullName, vbNormal) <> vbNullString Then
            Workbooks.Open Filename:=datFullName        '打开订单文件
            ext = Right(datfile, 3)
            If ext = "xls" Then
                MaxRow = Cells(65536, pos_sku).End(xlUp).Row
            Else
                MaxRow = Cells(1048576, pos_sku).End(xlUp).Row
            End If
        Else
            MsgBox "数据文件不存在！", vbOKOnly, "iamlaosong"
            Exit Sub
        End If
        
        tag_len = Len(pos_tag)
        Cells(pos_fst - 1, pos_sav) = pos_tag
        Cells(pos_fst - 1, pos_sav).Font.Bold = True
       
        '分离信息，取pos_tag和pos_end之间的信息
        For row1 = pos_fst To MaxRow
            buf = Cells(row1, pos_sku)
            m1 = InStr(1, buf, pos_tag, vbTextCompare)
            If m1 > 0 Then
                m2 = InStr(m1 + tag_len, buf, pos_end, vbTextCompare)
                buf_sel = Mid(buf, m1 + tag_len, m2 - m1 - tag_len)
            Else
                buf_sel = "notfound"
            End If
            Cells(row1, pos_sav + 0) = buf_sel
            '单元格中的数值是文本的，转换成数值型
            tmp = Cells(row1, 7)
            Cells(row1, 7) = CInt(tmp)
        Next row1
        '建立数据透视表
        pdata1 = ActiveSheet.name & "!R1C1:R" & MaxRow & "C9"     '数据源工作表
        Sheets.Add
        pdata2 = ActiveSheet.name & "!R3C1"                       '新增工作表
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pdata1, _
            Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=pdata2, _
            TableName:="拣货单数据透视表", DefaultVersion:=xlPivotTableVersion12
        '设置透视表格式，表格型、无小计    
        Cells(3, 1).Select
        ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("拣货储位").Subtotals(1) = False
        ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("货品名称").Subtotals(1) = False
        ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("颜色:").Subtotals(1) = False
        ActiveSheet.PivotTables("拣货单数据透视表").RowAxisLayout xlTabularRow
        
        '添加行标签和数值字段（计数、求和）
        With ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("拣货储位")
            .Orientation = xlRowField
            .Position = 1
        End With
        With ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("货品名称")
            .Orientation = xlRowField
            .Position = 2
        End With
        With ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("颜色:")
            .Orientation = xlRowField
            .Position = 3
        End With
        
        ActiveSheet.PivotTables("拣货单数据透视表").AddDataField ActiveSheet.PivotTables( _
            "拣货单数据透视表").PivotFields("拣货单号"), "拣货单数量", xlCount
        ActiveSheet.PivotTables("拣货单数据透视表").AddDataField ActiveSheet.PivotTables("拣货单数据透视表" _
            ).PivotFields("应拣货数量 "), "应拣货总量 ", xlSum
        
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\new" & datfile          'ActiveWorkbook.Save
        ActiveWindow.Close
        Windows(thisfile).Activate
        Worksheets("系统参数").Select
        Cells(unit_num, 3) = "成功"

    Next unit_num

    MsgBox "信息处理完毕！", vbOKOnly, "iamlaosong"
    Exit Sub
Err:
    MsgBox "错误#" & Str(Err.Number) & Err.Description & "-位置： " & row1, vbOKOnly + vbExclamation, "iamlaosong"
End Sub

4、生成的数据透视表如下所示：

5、关于取消汇总的语句，录制宏提供的语句是：

        ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("拣货储位").Subtotals = Array(False, _
            False, False, False, False, False, False, False, False, False, False, False)

实际上可以使用下面语句简化：

ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("拣货储位").Subtotals(1) = False