返回列表 上一主題 發帖

請問樞紐後如何快速擷取所需的欄位貼在另個檔案

回復 1# jessicamsu
報表活頁簿的ThisWorkbook模組
  1. Private Sub Workbook_Open()
  2. Dim PT As PivotTable, A As Range, s%, yn As Boolean, k%, Wb As Workbook, fs$
  3. Sheets("Sheet1").Columns("A:D").Clear
  4. fs = ThisWorkbook.Path & "\資料檔.xlsx"
  5. Set Wb = Workbooks.Open(fs)
  6. Set PT = Wb.Sheets("樞紐").PivotTables(1)
  7. With PT
  8. 10
  9. s = InputBox("輸入月份", , 9)
  10. If IsNumeric(Application.Match(s, .ColumnFields("月份").DataRange, 0)) Then
  11. s = Application.Match(s, .ColumnFields("月份").DataRange, 0)
  12. Else
  13. MsgBox "無此月份": GoTo 10
  14. End If
  15. For Each p In Array("地區別", "客戶", "產品")
  16. Set A = .PivotFields(p).DataRange
  17. If Application.CountBlank(A) > 0 Then yn = True Else yn = False
  18. Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).Value = A.Value
  19. If yn = True Then Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
  20. Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1) = Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).Value
  21. k = k + 1
  22. Next
  23. Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).Value = .DataBodyRange.Columns(s).Value
  24. End With
  25. Wb.Close 0
  26. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 【生命在呼吸間】佛陀說:「生命在呼吸間。」人無法管住自己的生命,更無法擋住死期,讓自己永住人間。既然生命去來這麼無常,我們更應該好好地愛惜它、利用它、充實它,讓這無常、寶貴的生命,散發它真善美的光輝,映照出生命真正的價值。
返回列表 上一主題