
ผมเขียนตัวอย่าง Code มาให้ตามด้านล่าง ลองนำไป Run ดูครับ
โดยให้แทรก Sheet1 มา 1 ชีท
จากนั้นนำ Code ด้านล่างไปวางที่ Module ปกติ
Code: Select all
Option Explicit
Sub UniqueDate()
Application.Calculation = xlCalculationManual
With Sheets("Sheet1")
.Select
.Range("A1:A7").Clear
Sheets("Database1").Range("A3:A1000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1"), Unique:=True
.Range("A1:A7").Sort Key1:=Range("A2"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
Sheets("Update opt").Activate
Application.Calculation = xlCalculationAutomatic
End Sub
Sub RefreshPiv()
Dim i As Integer
Dim r As Range
Set r = Sheets("Sheet1").Range("A3")
With Sheets("Update opt")
.Range("B1") = r
.Range("B6") = r
.Range("I6") = r.Offset(1, 0)
.Range("P6") = r.Offset(2, 0)
.Range("W6") = r.Offset(3, 0)
.Range("AD6") = .r.Offset(4,0)
For i = 1 To .PivotTables.Count
.PivotTables(i).PivotCache.Refresh
Next i
End With
End Sub
UniqueDate จะเป็นการสร้างวันที่แบบ Unique ก่อนนำไปใช้ ส่วน RefreshPiv จะทำการ Refresh PivotTable ทั้งหมดที่มีหลังจากได้นำวันที่มาวางตามตำแหน่งที่กำหนดไว้
และให้นำ Code ด้านล่างไปวางที่ ThisWorkbook เพื่อให้ Run Code ทั้งสองด้านบนแบบอัตโนมัติเมื่อเปิดไฟล์
Code: Select all
Option Explicit
Private Sub Workbook_Open()
UniqueDate
RefreshPiv
End Sub