作者：iamlaosong
有个拣货报表，想先从货品信息中分离出颜色信息，再根据储位、名称和颜色创建一个数据透视表，由于数据是变化的（结构不变，记录数会变），每次重新创建很麻烦，因此想做个工具，用VBA分离颜色并创建数据透视表，，供其他人使用。分离颜色的代码很好写，创建数据透视表的代码自然采用录制宏的方法最简单，代码出来后修改一下就行了。
1、工具界面如下：
2、拣货单的内容如下，需要分离SKU信息中的颜色：
3、工具的代码如下：
'分离信息Sub separate_information()On Error GoTo Errthisfile = ThisWorkbook.name '本文件的名字，这样赋值就可以随便改名了Worksheets("系统参数").SelectIf Cells(2, 2) = "Y" Or Cells(2, 2) = "y" Then'导出出库文件Application.ScreenUpdating = TrueElseApplication.ScreenUpdating = FalseEnd If'curdate = Cells(2, 2)'pos_qsh = Cells(2, 7)'pos_sku = Asc(Cells(3, 7)) – 64pos_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 Sublineno = [A65536].End(xlUp).Row'行数，文件数量For unit_num = 5 To lineno'文件循环datfile = Cells(unit_num, 2)'文件名称datFullName = ThisWorkbook.Path & "\&; & datfileIf Dir(datFullName, vbNormal) <> vbNullString ThenWorkbooks.Open Filename:=datFullName'打开订单文件ext = Right(datfile, 3)If ext = "xls" ThenMaxRow = Cells(65536, pos_sku).End(xlUp).RowElseMaxRow = Cells(1048576, pos_sku).End(xlUp).RowEnd IfElseMsgBox "数据文件不存在！", vbOKOnly, "iamlaosong"Exit SubEnd Iftag_len = Len(pos_tag)Cells(pos_fst – 1, pos_sav) = pos_tagCells(pos_fst – 1, pos_sav).Font.Bold = True'分离信息，取pos_tag和pos_end之间的信息For row1 = pos_fst To MaxRowbuf = Cells(row1, pos_sku)m1 = InStr(1, buf, pos_tag, vbTextCompare)If m1 > 0 Thenm2 = InStr(m1 + tag_len, buf, pos_end, vbTextCompare)buf_sel = Mid(buf, m1 + tag_len, m2 – m1 – tag_len)Elsebuf_sel = "notfound"End IfCells(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.Addpdata2 = 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 = 1End WithWith ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("货品名称").Orientation = xlRowField.Position = 2End WithWith ActiveSheet.PivotTables("拣货单数据透视表").PivotFields("颜色:").Orientation = xlRowField.Position = 3End With ActiveSheet.PivotTables("拣货单数据透视表").AddDataField ActiveSheet.PivotTables( _ "拣货单数据透视表").PivotFields("拣货单号"), "拣货单数量", xlCount ActiveSheet.PivotTables("拣货单数据透视表").AddDataField ActiveSheet.PivotTables("拣货单数据透视表" _ ).PivotFields("应拣货数量 "), "应拣货总量 ", xlSum ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\new" & datfile'ActiveWorkbook.SaveActiveWindow.CloseWindows(thisfile).ActivateWorksheets("系统参数").SelectCells(unit_num, 3) = "成功"Next unit_numMsgBox "信息处理完毕！", vbOKOnly, "iamlaosong"Exit SubErr:MsgBox "错误#" & Str(Err.Number) & Err.Description & "-位置： " & row1, vbOKOnly + vbExclamation, "iamlaosong"End Sub4、生成的数据透视表如下所示：而这些目标凝结成希望的萌芽，在汗水与泪水浇灌下，绽放成功之花。
