VBA：新增 樞紐分析表 PivotTable

SHEET_NAME：資料來源工作表 

插入一個按鈕，呼叫副程式，並指定工作表名稱即可。

	Function addPivotTable(SHEET_NAME)
	On Error GoTo LINE1
	Dim sht As Worksheet
	Dim pvtCache As PivotCache
	Dim pvt As PivotTable
	Dim StartPvt As String
	Dim SrcData As String
	'TARGET_NAME = "TEST"
	Sheets(SHEET_NAME).Activate
	ROWS_COUNT = Application.CountA(ActiveSheet.Range("1:1"))
	TARGET_ADDRESS = Split(ActiveSheet.Cells(1, ROWS_COUNT).Address, "$")
	COLUMNS_COUNT = Application.CountA(ActiveSheet.Range("A:A"))
	SrcData = ActiveSheet.Name & "!" & Range("A1:" & TARGET_ADDRESS(1) & COLUMNS_COUNT).Address(ReferenceStyle:=xlR1C1)
	RAWDATA = Sheets(SHEET_NAME).Range("A1:" & TARGET_ADDRESS(1) & COLUMNS_COUNT)
	Set sht = Sheets.Add
	StartPvt = sht.Name & "!" & sht.Range("A1").Address(ReferenceStyle:=xlR1C1)
	Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
	SourceType:=xlDatabase, _
	SourceData:=SrcData)
	Set pvt = pvtCache.CreatePivotTable( _
	TableDestination:=StartPvt, _
	TableName:="PivotTable1")
	addPivotTable = "PivotTable1"
	Exit Function
	LINE1:
	MsgBox "error"
	End Function

view raw gistfile1.txt hosted with ❤ by GitHub

Private Sub CommandButton1_Click()

    Call addPivotTable("DEMO")

End Sub

gif 演示：