VBA สำหรับ Pivot แบบ Fixed condition

[petchpetchy]

ต้องการ สร้าง Macro เพื่อสร้าง Pivot Table ในชีทใหม่ โดย Fixed condition การ Filter ไว้ตามในไฟล์
ตอนนี้ใช้วิธี record แล้วมาแก้เอาครับ

พบปัญหาคือ ใช้งานได้แค่ครั้งแรก เพราะ Macro จะสร้าง Sheet1 แต่พอกดครั้งที่ สอง สาม สี่ จะเป็น Sheet 2 3 4 ซึ่งจะ error

คำถามคือ
1. แก้ปัญหาตรงนี้อย่างไรครับ ให้ไม่เกิดการเปลี่ยน Sheet1 เป็น 2 3 4 ทุกครั้งที่ Run
2. ในส่วนของการ Selection Range. มีวิธีเขียนแบบอื่นที่ง่ายกว่านี้ไหมครับ
3. ตอนนี้เวลาใช้งาน ผมจะเปิดไฟล์ xlsm แล้วย่อไว้ จากนั้นเปิดไฟล์ xlsx อีกอัน แล้วค่อยกด Run macro มีวิธีเขียนให้กดจาก xlsm แล้วเลือกไฟล์เป้าหมายได้ไหมครับ

Code: Select all

Sub Macro2()
    'Select Range
    Dim Rng As Range
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(2).Select
    Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select
    Set Rng = Selection
    Rng.Select
    
    'For Pivot
    Application.CutCopyMode = False
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Rng, Version:=7).CreatePivotTable TableDestination:= _
        "Sheet8!R3C1", TableName:="PivotTable1", DefaultVersion:=7
    Sheets("Sheet8").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
    
    'For Filter
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Volume"), "Sum of Volume", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("FY")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("yyyy/mm")
        .Orientation = xlRowField
        .Position = 1
    End With
    
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub Macro2()
    'Select Range
    Dim Rng As Range, sh As Worksheet
    
    On Error Resume Next
    Set sh = Worksheets("Sheet1")
    If Not sh Is Nothing Then Exit Sub
    
'    Range("A1").Select
'    Selection.End(xlDown).Select
'    Selection.End(xlDown).Select
'    Selection.End(xlDown).Select
'    Selection.End(xlDown).Select
'    Selection.End(xlDown).Select
'    ActiveCell.Offset(2).Select
    Range("f11").End(xlDown).Select
    Range(ActiveCell, ActiveCell.End(xlToLeft).End(xlDown)).Select
'Other code

สำหรับการเปิดไฟล์ด้วย Code สามารถบันทึก Macro แล้วดู Code ได้ ลองเขียนมาเองดูก่อน ติดตรงไหนค่อยถามกันต่อครับ