- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 142
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2026-7-16
                
|
3#
發表於 2012-9-29 00:45
| 只看該作者
回復 1# jessicamsu
報表活頁簿的ThisWorkbook模組- Private Sub Workbook_Open()
- Dim PT As PivotTable, A As Range, s%, yn As Boolean, k%, Wb As Workbook, fs$
- Sheets("Sheet1").Columns("A:D").Clear
- fs = ThisWorkbook.Path & "\資料檔.xlsx"
- Set Wb = Workbooks.Open(fs)
- Set PT = Wb.Sheets("樞紐").PivotTables(1)
- With PT
- 10
- s = InputBox("輸入月份", , 9)
- If IsNumeric(Application.Match(s, .ColumnFields("月份").DataRange, 0)) Then
- s = Application.Match(s, .ColumnFields("月份").DataRange, 0)
- Else
- MsgBox "無此月份": GoTo 10
- End If
- For Each p In Array("地區別", "客戶", "產品")
- Set A = .PivotFields(p).DataRange
- If Application.CountBlank(A) > 0 Then yn = True Else yn = False
- Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).Value = A.Value
- If yn = True Then Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
- Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1) = Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).Value
- k = k + 1
- Next
- Sheets("Sheet1").[A1].Offset(, k).Resize(A.Rows.Count, 1).Value = .DataBodyRange.Columns(s).Value
- End With
- Wb.Close 0
- End Sub
複製代碼 |
|