返回列表 上一主題 發帖

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

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

請問有一個報表(如附件)在9月份欄位,是依據資料檔的樞紐SHEET貼至報表檔而來而來
因為每個月都要update QTY的資料,
有沒有什麼方式在資料檔樞紐完後,可以在開啟"報表"檔案時,下指令需要update的月份後,就可自動update資料?
謝謝


報表.zip (7.08 KB) 資料檔.zip (11.61 KB)
Jessica

回復 1# jessicamsu

按"F5"鍵

TOP

回復 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

        靜思自在 : 人生最大的成就是從失敗中站起來。
返回列表 上一主題