運算問題 - Excel程式區 - 麻辣家族討論版版

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

1^# 跳轉到 »

發表於 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元的贊助,人人有能力.

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

2^#

發表於 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

複製代碼

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

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

3^#

發表於 2013-8-23 14:41 | 顯示全部帖子

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

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

[發問] 運算問題