累計加總數量及每週加總數量

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

1^# 跳轉到 »

發表於 2014-4-19 15:20 | 顯示全部帖子

回復 6# yen956

複製代碼

這也是3月1日的前一天

複製代碼

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

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

2^#

發表於 2014-4-19 16:24 | 顯示全部帖子

回復 8# yen956
也可以如此

Private Sub EX()
Dim i As Integer, Rng As Range, MoDay As Date
MoDay = DateSerial([n1], [q1], 1)
With Range("C2:C4")
.Resize(, 31) = ""
With .Offset(3).Resize(, 31)
.UnMerge
.Rows("2:3") = ""
End With
i = 1
Do While Month(MoDay + i - 1) = Month(MoDay) '同一月份
.Cells(1, i) = MoDay + i - 1
.Cells(2, i) = i
.Cells(3, i) = Weekday(MoDay + (i - 1), 2)
.Cells(5, i) = Application.Evaluate("Sum(" & .Cells(4, 1).Resize(, i).Address & ")")
If .Cells(3, i) = 7 Or i = Day(DateAdd("M", 1, MoDay) - 1) Then '或是此月份最後一天
If i <= 7 Then '第一週
Set Rng = .Cells(6, i).Offset(, -(i - 1)).Resize(, i)
ElseIf .Cells(3, i) = 7 Then '每週
Set Rng = .Cells(6, i).Offset(, -6).Resize(, 7)
ElseIf i = Day(DateAdd("M", 1, MoDay) - 1) Then '月底
Set Rng = .Cells(6, i).Offset(, -(.Cells(3, i) - 1)).Resize(, .Cells(3, i))
End If
With Rng
.Merge
.Cells(1) = Application.Evaluate("Sum(" & .Offset(-2).Cells(1).Resize(, .Columns.Count).Address & ")")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
End If
i = i + 1
Loop
End With
End Sub

複製代碼

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

靜思自在 : 心中常存善解、包容、感思、知足、惜福。