Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://snasui.com/

VBA เขียนสร้าง Pivot ให้ทำงาน

https://snasui.com/viewtopic.php?t=7626

Page 1 of 1

VBA เขียนสร้าง Pivot ให้ทำงาน

Posted: Wed Oct 15, 2014 1:27 pm
by Supachok
ในวงเล็บตอนท้ายจะเป็นภาษา ต่างดาว
ผมเขียน VBA ไม่เป็นในการกำหนดค่าตัวแปรต่างๆ
เข้าใช้แต่ Basic ในการ Reference cell และ Activate

จึงใช้วิธี Save Marco จาก Excel แทนในการเขียนสูตร

คำถาม
ภาษา ต่างดาวไม่สามารถ Copy ไม่ใช้ต่อได้ - เราแก้สูตรได้อย่างไรบ้าง
ปล
ข้อมูลหลักอ้างอิง Column (K:K,Y:Y)



With ActiveSheet.PivotTables("PivotTable1").PivotFields("ö")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("§Ò¹¢Í§Çѹ·Õè")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Òä»")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Ò¡ÅѺ")
.Orientation = xlRowField
.Position = 4
End With
Range("A4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("ö").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
Range("B4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("§Ò¹¢Í§Çѹ·Õè").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("C4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Òä»").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("K5").Select

------------------------------------------------------------------------------------------------------------------------------------

สูตรเต็มที่ใช้งานอยู่

Sub remainbox()
'
' Macro1 áÁâ¤Ã
'

'
Cells(1, 1).Select
ActiveCell.FormulaR1C1 = "pivote"

Dim i As Long
Dim r As Range
On Error Resume Next
With Worksheets("sheet1")
Set r = .Range(.Range("A1"), Range("A1").End(xlUp))
End With
For i = 1 To r.Count
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = _
r.Cells(i, 1).Value
Next i


ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R2C1:R1035C49", Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:="pivote!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion10
Sheets("Sheet5").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("ö")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("§Ò¹¢Í§Çѹ·Õè")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Òä»")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Ò¡ÅѺ")
.Orientation = xlRowField
.Position = 4
End With
Range("A4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("ö").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
Range("B4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("§Ò¹¢Í§Çѹ·Õè").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("C4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Òä»").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("K5").Select
ActiveWindow.SmallScroll Down:=0
ActiveCell.FormulaR1C1 = "=RC[-7]-R[1]C[-8]"
Range("K5").Select
Selection.Copy
Columns("K:K").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-21
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=-1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

ActiveSheet.Buttons.Add(0, 0.75, 69.75, 14.25).Select
Selection.OnAction = "PERSONAL.XLSB!uuuu"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "exit"
With Selection.Characters(Start:=1, Length:=4).Font
.Name = "Tahoma"
.FontStyle = "¸ÃÃÁ´Ò"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = 2
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("D1").Select




End Sub

Re: VBA เขียนสร้าง Pivot ให้ทำงาน

Posted: Wed Oct 15, 2014 6:32 pm
by snasui
:D ไม่พบ Code ในไฟล์แนบครับ

สำหรับการวาง Code ควรวางให้แสดงเป็น Code ดูตัวอย่างจากที่นี่ครับ viewtopic.php?style=3&f=3&t=1187

Re: VBA เขียนสร้าง Pivot ให้ทำงาน

Posted: Thu Oct 16, 2014 2:58 pm
by Supachok
Sub remainbox()
'
' Macro1 áÁâ¤Ã
'

'
Cells(1, 1).Select
ActiveCell.FormulaR1C1 = "pivote"

Dim i As Long
Dim r As Range
On Error Resume Next
With Worksheets("sheet1")
Set r = .Range(.Range("A1"), Range("A1").End(xlUp))
End With
For i = 1 To r.Count
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = _
r.Cells(i, 1).Value
Next i


ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R2C1:R1035C49", Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:="pivote!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion10
Sheets("Sheet5").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("ö")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("§Ò¹¢Í§Çѹ·Õè")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Òä»")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Ò¡ÅѺ")
.Orientation = xlRowField
.Position = 4
End With
Range("A4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("ö").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
Range("B4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("§Ò¹¢Í§Çѹ·Õè").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("C4").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("àÅ¢äÁÅì¢Òä»").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("K5").Select
ActiveWindow.SmallScroll Down:=0
ActiveCell.FormulaR1C1 = "=RC[-7]-R[1]C[-8]"
Range("K5").Select
Selection.Copy
Columns("K:K").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-21
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=-1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

ActiveSheet.Buttons.Add(0, 0.75, 69.75, 14.25).Select
Selection.OnAction = "PERSONAL.XLSB!uuuu"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "exit"
With Selection.Characters(Start:=1, Length:=4).Font
.Name = "Tahoma"
.FontStyle = "¸ÃÃÁ´Ò"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = 2
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("D1").Select

Code: Select all

Re: VBA เขียนสร้าง Pivot ให้ทำงาน

Posted: Thu Oct 16, 2014 3:03 pm
by Supachok
เรียน ท่านอาจารย์

ผมทำไม่เป็นครับ
คือตอนอยู่ในเครื่อง ก็กด Run marco ได้

จะส่งไฟล์ธรรมดา ขนาดยัง 600 KB เลยครับ เลยต้อง ZIP
ไม่รู้ว่าจะทำไงต่อดีครับ :oops: :cry:

Re: VBA เขียนสร้าง Pivot ให้ทำงาน

Posted: Fri Oct 17, 2014 6:31 am
by snasui
:D ไฟล์ตัวอย่างไม่ควรมีขนาดใหญ่ ตัดมาเพียงบางส่วนแล้วแปลงข้อมูลให้เป็นตัวอย่าง

การใช้ Macro จะต้องแนบ Code แนบไฟล์ที่มี Macro เพื่อสะดวกในการตอบ ไม่ว่าจะเขียนเองหรือบันทึก Macro ก็ตามครับ

การแนบ Code ในไฟล์ได้ ไฟล์นั้นจะต้องมีนามสกุล .xlsm เป็นอยางน้อยครับ

Re: VBA เขียนสร้าง Pivot ให้ทำงาน

Posted: Fri Oct 17, 2014 7:54 am
by Supachok
ขอบคุณครับ

พอจะพบทางสว่างแล้ว :P
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited