1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2013-8-18 11:12 | 只看該作者

[發問] 運算問題

麻煩版大幫幫忙 !
我把內容都寫到附件裡了,這樣會比較方便,閱覽 ~
感恩 ~

test.rar (20.68 KB)

樞紐運算

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2013-8-20 16:38 | 只看該作者

回復 1# jackyliu
這程式碼是依據,附檔[TEST]的樞紐分析表的現有結構而寫的

Sub Ex()
Dim D_1, D_2, R As Range, M As Integer
With Sheets("TEST").PivotTables(1) '工作表的幣一個,樞紐分析表.
.Parent.Cells.Interior.ColorIndex = xlNone
With .ColumnRange
.Cells(1, .Columns.Count + 1).EntireColumn.Clear '樞紐分析表的欄位的最右邊的下一欄: 整欄全部清除
End With
Application.DisplayAlerts = False
.SourceData = Sheets("RAW").Range("A1").CurrentRegion.Address(, , xlR1C1, 1)
'更新資料庫的位置 CurrentRegion不會包含有空白的資料
'原先資料庫的位置=> A:D 的整欄包含有空白的資料
Application.DisplayAlerts = True
.PivotCache.Refresh
With .ColumnRange '樞紐分析表的欄位
M = .Cells(1, .Columns.Count + 1).Column '樞紐分析表的欄位的最右邊的下一欄
D_1 = CDate(Application.Large(.Rows(2), 1)) '最大的日期
D_2 = CDate(Application.Large(.Rows(2), 2)) '次一日的日期
D_1 = .Rows(2).Find(D_1, LookIn:=xlValues).Column '最大日期的欗號
D_2 = .Rows(2).Find(D_2).Column '次一日的欗號
End With
For Each R In .RowRange.Columns(1).Cells '樞紐分析表的列的第1欄
If InStr(R, "合計") Then
R.Resize(, .RowRange.Columns.Count + .ColumnRange.Columns.Count).Interior.Color = vbYellow
With .Parent '樞紐分析表的父層 :工作表
.Cells(R.Row, M) = .Cells(R.Row, D_1) - .Cells(R.Row, D_2)
End With
End If
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

3^#

發表於 2013-8-20 21:46 | 只看該作者

回復 2# GBKEE

版大:
目前指針對有合計的部份做運算,能增加每行也加入運算嗎?

test.JPG (95.55 KB)

目前執行畫面

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2013-8-21 14:06 | 只看該作者

回復 3# jackyliu

Sub Ex()
Dim D_1, D_2, R As Range, M As Integer
With Sheets("TEST").PivotTables(1) '工作表的幣一個,樞紐分析表.
.Parent.Cells.Interior.ColorIndex = xlNone
With .ColumnRange
.Cells(1, .Columns.Count + 1).EntireColumn.Clear '樞紐分析表的欄位的最右邊的下一欄: 整欄全部清除
End With
Application.DisplayAlerts = False
.SourceData = Sheets("RAW").Range("A1").CurrentRegion.Address(, , xlR1C1, 1)
'更新資料庫的位置 CurrentRegion不會包含有空白的資料
'原先資料庫的位置=> A:D 的整欄包含有空白的資料
Application.DisplayAlerts = True
.PivotCache.Refresh
With .ColumnRange '樞紐分析表的欄位
M = .Cells(1, .Columns.Count + 1).Column '樞紐分析表的欄位的最右邊的下一欄
D_1 = CDate(Application.Large(.Rows(2), 1)) '最大的日期
D_2 = CDate(Application.Large(.Rows(2), 2)) '次一日的日期
D_1 = .Rows(2).Find(D_1, LookIn:=xlValues).Column '最大日期的欗號
D_2 = .Rows(2).Find(D_2).Column '次一日的欗號
End With
Set R = .RowRange.Columns(1).Cells(2)
Do While Not Intersect(R, .RowRange.Columns(1)) Is Nothing
If InStr(R, "合計") Then
R.Resize(, .RowRange.Columns.Count + .ColumnRange.Columns.Count).Interior.Color = vbYellow
End If
With .Parent '樞紐分析表的父層 :工作表
.Cells(R.Row, M) = .Cells(R.Row, D_1) - .Cells(R.Row, D_2)
End With
Set R = R.Offset(1)
Loop
End With
End Sub