สอบถามการแก้ไข CODE สำหรับ VLOOKUP PIVOT ข้าม SHEET ใน VBA ค่า

[iamiice]

สอบถามการแก้ไข CODE สำหรับ VLOOKUP PIVOT ข้าม SHEET ใน VBA ค่า
รวมถึงเป็นการเลือกเซลล์ใน PIVOT จากคอลัมข้างบนแล้ว ctrl+shift+ลูกศรลงมาข้าง
เพื่อให้เป็นข้อมูลไม่สิ้นสุดด้วยค่ะ พยายามมาสักพักแล้ว ค่อนข้างงง
รบกวนสอบถามผู้รู้หน่อยนะคะ

ขอบคุณมากๆ ค่า

Code: Select all

Sub SUM()
'
' SUM Macro
'
'Add this code=====
Dim dataname As String 'for get table name
Dim datasheetname As String 'For get sheet name
Dim pivotsheetname As String 'For namung pivotsheet&pivotname from current sheet name

dataname = ActiveSheet.ListObjects(1).Name 'Get table name
datasheetname = ActiveSheet.Name 'Get sheet name
pivotsheetname = "Pivot" & datasheetname 'naming pivotsheet from current sheet name
pivotname = pivotsheetname
'End Adding=====
'
Range("Table1[[#Headers],[Document Date]]").Select
Application.CutCopyMode = False
Sheets.Add
ActiveSheet.Name = pivotsheetname
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
dataname, Version:=6).CreatePivotTable TableDestination:=pivotsheetname & "!R3C1", _
TableName:=pivotname, DefaultVersion:=6
Sheets(pivotsheetname).Select
Cells(3, 1).Select
With ActiveSheet.PivotTables(pivotname)
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables(pivotname).PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables(pivotname).RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables(pivotname).PivotFields("Sales Document")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables(pivotname).AddDataField ActiveSheet.PivotTables( _
pivotname).PivotFields("Confirmed Quantity"), "Sum of Confirmed Quantity", _
xlSum
ActiveSheet.PivotTables(pivotname).PivotSelect "'Sales Document'[All]", _
xlLabelOnly + xlFirstRow, True
ActiveSheet.PivotTables(pivotname).PivotFields("Sales Document").AutoSort _
xlAscending, "Sales Document"
Sheets(datasheetname).Select
Range("B4").Select
ActiveSheet.Range("Table1[#All]").RemoveDuplicates Columns:=2, Header:= _
xlYes
ActiveWindow.SmallScroll Down:=-9
ActiveWorkbook.Worksheets(datasheetname).ListObjects(dataname).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(datasheetname).ListObjects(dataname).Sort.SortFields.Add2 _
Key:=Range("Table1[[#All],[Sales Document]]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(datasheetname).ListObjects(dataname).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("I2").Select
ActiveWindow.SmallScroll Down:=-6
ActiveCell.FormulaR1C1 = ""
Range("I7").Select
ActiveWindow.SmallScroll Down:=-12
Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],PivotSheet1! !R[2]C[-8]:R[268]C[-7],2,0)"
Range("J2").Select
ActiveWindow.SmallScroll Down:=-3
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.FormulaR1C1 = "=RC[-4]-RC[-1]"
End Sub

ตรงที่แจ้งว่าเกิด bug คือตรงนี้ค่ะ ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],PivotSheet1! !R[2]C[-8]:R[268]C[-7],2,0)"

ขอบคุณมากๆนะคะ

[snasui]

กรุณาเปลี่ยนนคำว่า "ค่า" ที่ใช้แทน "ค่ะ" ให้เป็นคำว่า "ค่ะ" อ่านกฎการใช้บอร์ดข้อ 1 ด้านบนประกอบครับ

นอกจากนั้นให้แนบตัวอย่างไฟล์ Excel ที่เกิดปัญหามาด้วยจะได้ช่วยกันทดสอบได้ การแนบไฟล์อ่านกฎการใช้บอร์ดข้อ 4 และ 5 ด้านบนประกอบครับ