Board logo

標題: [發問] 運算問題 [打印本頁]
作者: jackyliu    時間: 2013-8-18 11:12     標題: 運算問題

麻煩版大 幫幫忙 !
我把內容都寫到 附件裡了,這樣會比較方便,閱覽 ~
感恩 ~
作者: GBKEE    時間: 2013-8-20 16:38

回復 1# jackyliu
這程式碼是依據,附檔[TEST]的樞紐分析表的現有結構而寫的
  1. Sub Ex()
  2.     Dim D_1, D_2, R As Range, M As Integer
  3.     With Sheets("TEST").PivotTables(1)                           '工作表的幣一個,樞紐分析表.
  4.         .Parent.Cells.Interior.ColorIndex = xlNone
  5.         With .ColumnRange
  6.             .Cells(1, .Columns.Count + 1).EntireColumn.Clear    '樞紐分析表的欄位的最右邊的下一欄: 整欄 全部清除
  7.         End With
  8.         Application.DisplayAlerts = False
  9.         .SourceData = Sheets("RAW").Range("A1").CurrentRegion.Address(, , xlR1C1, 1)
  10.         '更新資料庫的位置   CurrentRegion不會包含有空白的資料
  11.         '原先資料庫的位置=> A:D 的整欄包含有空白的資料
  12.         Application.DisplayAlerts = True
  13.         .PivotCache.Refresh
  14.         With .ColumnRange                                           '樞紐分析表的欄位
  15.             M = .Cells(1, .Columns.Count + 1).Column                '樞紐分析表的欄位的最右邊的下一欄
  16.             D_1 = CDate(Application.Large(.Rows(2), 1))             '最大的日期
  17.             D_2 = CDate(Application.Large(.Rows(2), 2))             '次一日的日期
  18.             D_1 = .Rows(2).Find(D_1, LookIn:=xlValues).Column       '最大日期的欗號
  19.             D_2 = .Rows(2).Find(D_2).Column                         '次一日的欗號
  20.         End With
  21.         For Each R In .RowRange.Columns(1).Cells                    '樞紐分析表的列的第1欄
  22.             If InStr(R, "合計") Then
  23.                 R.Resize(, .RowRange.Columns.Count + .ColumnRange.Columns.Count).Interior.Color = vbYellow
  24.                 With .Parent                                        '樞紐分析表的父層 :工作表
  25.                 .Cells(R.Row, M) = .Cells(R.Row, D_1) - .Cells(R.Row, D_2)
  26.                 End With
  27.             End If
  28.         Next
  29.     End With
  30. End Sub
複製代碼
作者: jackyliu    時間: 2013-8-20 21:46

回復 2# GBKEE

版大:
  目前指針對有合計的部份做運算,能增加每行也加入運算嗎?
作者: GBKEE    時間: 2013-8-21 14:06

回復 3# jackyliu
  1. Sub Ex()
  2.     Dim D_1, D_2, R As Range, M As Integer
  3.     With Sheets("TEST").PivotTables(1)                           '工作表的幣一個,樞紐分析表.
  4.         .Parent.Cells.Interior.ColorIndex = xlNone
  5.         With .ColumnRange
  6.             .Cells(1, .Columns.Count + 1).EntireColumn.Clear    '樞紐分析表的欄位的最右邊的下一欄: 整欄 全部清除
  7.         End With
  8.         Application.DisplayAlerts = False
  9.         .SourceData = Sheets("RAW").Range("A1").CurrentRegion.Address(, , xlR1C1, 1)
  10.         '更新資料庫的位置   CurrentRegion不會包含有空白的資料
  11.         '原先資料庫的位置=> A:D 的整欄包含有空白的資料
  12.         Application.DisplayAlerts = True
  13.         .PivotCache.Refresh
  14.         With .ColumnRange                                           '樞紐分析表的欄位
  15.             M = .Cells(1, .Columns.Count + 1).Column                '樞紐分析表的欄位的最右邊的下一欄
  16.             D_1 = CDate(Application.Large(.Rows(2), 1))             '最大的日期
  17.             D_2 = CDate(Application.Large(.Rows(2), 2))             '次一日的日期
  18.             D_1 = .Rows(2).Find(D_1, LookIn:=xlValues).Column       '最大日期的欗號
  19.             D_2 = .Rows(2).Find(D_2).Column                         '次一日的欗號
  20.         End With
  21.         Set R = .RowRange.Columns(1).Cells(2)
  22.         Do While Not Intersect(R, .RowRange.Columns(1)) Is Nothing
  23.             If InStr(R, "合計") Then
  24.                 R.Resize(, .RowRange.Columns.Count + .ColumnRange.Columns.Count).Interior.Color = vbYellow
  25.             End If
  26.             With .Parent                                        '樞紐分析表的父層 :工作表
  27.                 .Cells(R.Row, M) = .Cells(R.Row, D_1) - .Cells(R.Row, D_2)
  28.             End With
  29.             Set R = R.Offset(1)
  30.         Loop
  31.     End With
  32. End Sub
複製代碼
作者: jackyliu    時間: 2013-8-22 21:32

回復 4# GBKEE

版大 :

好像沒有 一開始需求說明的第二項功能耶...
2. 提供選擇日期區間，方便看日期區間內的資料。【不用使用Execl 內的勾選功能】

這有辦法做到用 提供選擇日期區間 嗎 ?
作者: GBKEE    時間: 2013-8-23 14:41

回復 5# jackyliu
這有辦法做到用 提供選擇日期區間 嗎?
是可以的,但你應該是多認識VBA的函數,物件的屬性,方法.練習自己來寫,才有成就感的.
作者: jackyliu    時間: 2013-8-24 22:20

回復 6# GBKEE

感謝 ~



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)