|
Option Explicit
Sub test3()
Application.ScreenUpdating = False
Call test1
Call test2
End Sub
'创建方式1:先创建数据透视表缓存对象,再创建数据透视表
Sub test1()
Dim data As Range
Dim pc As PivotCache
Dim pt As PivotTable
'指定数据源
Set data = Sheets(1).[a1].CurrentRegion
'创建空白工作表,存放数据透视表。
Sheets.Add after:=Sheets(Sheets.Count)
'创建 数据透视表的缓存(PivotCache 对象)
Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, data, xlPivotTableVersion12) 'Excel 2007
'创建一个基于 数据透视表的缓存(PivotCache 对象)的数据透视表。透视表左上角在A1
Set pt = pc.CreatePivotTable([a1])
With pt
.PivotFields("Model").Orientation = xlRowField
.PivotFields("Side").Orientation = xlRowField
.PivotFields("PartNO.").Orientation = xlRowField
.PivotFields("Data").Orientation = xlColumnField
.PivotFields("BOM Spec (Revision)").Orientation = xlDataField
'4)其它设置
'对数据透视表中的所有透视字段重复项目标签
.RepeatAllLabels xlRepeatLabels
'同时为所有现有的透视字段设置版式选项:表格形式
.RowAxisLayout xlTabularRow
'隐藏行总计
.RowGrand = False
'隐藏列总计
.ColumnGrand = False
'不显示分类汇总(12个 False)
.PivotFields("Model").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("Side").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("PartNO.").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
End Sub
Sub test2()
Dim A, d, i, j, x
'创建字典
Set d = CreateObject("scripting.dictionary")
A = Sheets(1).UsedRange
For i = 2 To UBound(A)
x = ""
For j = 1 To 4
x = x & "," & A(i, j)
Next j
d(x) = A(i, 5)
Next i
'查询字典
A = ActiveSheet.UsedRange.Offset(1, 0)
Cells.Clear
Rows(1).NumberFormatLocal = "yyyy/m/d"
[a1].Resize(UBound(A), UBound(A, 2)) = A
For i = 2 To UBound(A)
For j = 4 To UBound(A, 2)
x = "," & A(1, j) & "," & A(i, 1) & "," & A(i, 2) & "," & A(i, 3)
If d.exists(x) Then A(i, j) = d(x)
Next j
Next i
[a1].Resize(UBound(A), UBound(A, 2)) = A
' Range("a1").CurrentRegion.EntireColumn.AutoFit
End Sub
BOM Version Check sheet_2.rar
(26.08 KB, 下载次数: 3)
|
|