Page 1 of 1

แก้ไข macro ที่ใช้ Pivot Table ในกรณีที่มีการเพิ่มแถวหรือคอลัมน์ของข้อมูล

Posted: Tue Apr 24, 2018 11:06 am
by Tudtoo
ต้องการแก้ไข macro ที่ใช้ Pivot Table ในกรณีที่ข้อมูลที่ใช้มีการเพิ่มแถวหรือคอลัมน์
"ตัวอย่างโค้ดที่ได้จากการบันทึก macro ครั้งแรก"

Code: Select all

 Range("A1").Select
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "ใบเจน PO."
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "ใบเจน PO.!R1C1:R841C25", Version:=6).CreatePivotTable TableDestination:= _
        "Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("Sheet2").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1")
        .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("PivotTable1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Article")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Quantity in SKU"), "Sum of Quantity in SKU", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Order Quantity"), "Sum of Order Quantity", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Net Order Value"), "Sum of Net Order Value", xlSum
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "SUM PO.เจน"
End Sub

Re: แก้ไข macro ที่ใช้ Pivot Table ในกรณีที่มีการเพิ่มแถวหรือคอลัมน์ของข้อมูล

Posted: Tue Apr 24, 2018 2:45 pm
by logic
ทำไฟล์ตัวอย่างแนบมาด้วยจะได้ช่วยกันดูครับ

Re: แก้ไข macro ที่ใช้ Pivot Table ในกรณีที่มีการเพิ่มแถวหรือคอลัมน์ของข้อมูล

Posted: Tue Apr 24, 2018 3:06 pm
by Tudtoo
จากไฟล์ตัวอย่างต้องการ Pivot ข้อมูลในช่อง M และ S ซึ่งในแต่ละวันจำนวน row จะไม่เท่ากันทำให้ pivot ข้อมูลมาไม่ครบทั้งหมด

Re: แก้ไข macro ที่ใช้ Pivot Table ในกรณีที่มีการเพิ่มแถวหรือคอลัมน์ของข้อมูล

Posted: Tue Apr 24, 2018 7:10 pm
by snasui
:D ไฟล์ที่แนบคือไฟล์ที่เขี่ยน Code เอาไว้แล้ว จะต้องมีนามสกุลเป็น .xlsm เป็นอย่างน้อยไม่ใช่นามสกุลเป็น .xlsx ช่วยแนบมาใหม่อีกรอบครับ

Re: แก้ไข macro ที่ใช้ Pivot Table ในกรณีที่มีการเพิ่มแถวหรือคอลัมน์ของข้อมูล

Posted: Wed Apr 25, 2018 3:18 pm
by Tudtoo
แก้ไขไฟล์แนบให้ใหม่แล้วค่ะ ขอบคุณค่ะ
ใบเจน Po..xlsm
(363.6 KiB) Downloaded 6 times

Re: แก้ไข macro ที่ใช้ Pivot Table ในกรณีที่มีการเพิ่มแถวหรือคอลัมน์ของข้อมูล

Posted: Wed Apr 25, 2018 8:06 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code...
    Dim data As Range
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "ใบเจน PO."
    With ActiveSheet
        Set data = .UsedRange
    End With
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        data, Version:=6).CreatePivotTable TableDestination:= _
        "Sheet3!R3C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("Sheet1").Select
'Other code...