返回列表 上一主題 發帖

[發問] Q15:Q26為E2所輸入日期以前的總和(已解決)

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2010-8-30 22:48 | 顯示全部帖子
本帖最後由 Hsieh 於 2010-8-31 00:14 編輯

回復 13# olisun
累計區塊計算
  1. Sub 累計()
  2. Dim d as Object,sh as WorkSheet,r as Long,a as Range,w As String,dt As Date,b As Range,at As String
  3. Set d = CreateObject("Scripting.Dictionary") '建立字典物件
  4. For Each sh In Sheets(Array("派夾報宣傳車", "NP、CF")) '在2個資料工作表循環
  5. With sh
  6. r = 3
  7. dt = .Cells(r, 1) '資料工作表A欄的日期
  8.   Do Until dt > Sheets("日報表").[E2]  '當日期超過就跳離迴圈
  9.      For Each a In .Range(.[B2], .[B2].End(xlToRight))  '資料工作表第2列做循環
  10.         w = a.Offset(-1, 0).MergeArea.Cells(1, 1)  '第一列對應到的內容因為有合併儲存格所以取合併範圍第一格的值寫入變數
  11.         d(w & a) = d(w & a) + .Cells(r, a.Column).Value  '以種類跟區域字串做索引儲存對應到的值
  12.      Next
  13.      r = r + 1
  14.      dt = .Cells(r, 1)  '寫入下一個日期
  15.   Loop
  16.   End With
  17. Next
  18. With Sheets("日報表")
  19. For Each a In .[B15:B26]
  20. at = a
  21.    For Each b In .[P14:U14]
  22.       If b.Column > 18 Then at = ""  '因為18欄以後沒有地區所以要讓地區變數變空
  23.       .Cells(a.Row, b.Column) = d(b & at)  '寫回日報表
  24.    Next
  25. Next
  26. End With
  27. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2010-8-30 23:15 | 顯示全部帖子
本帖最後由 Hsieh 於 2010-8-30 23:31 編輯

回復 15# olisun
如果你敘述沒錯那就是筆誤多一行r=r+1(已修正)
如果是同一周累計
  1. Sub 同周累計()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each sh In Sheets(Array("派夾報宣傳車", "NP、CF"))
  4. With sh
  5. r = 3
  6.   Do Until .Cells(r, 1) = "" 'Sheets("日報表").[E2]
  7.      dt = .Cells(r, 1)
  8.      If Year(dt) = Year(Sheets("日報表").[E2]) And Application.WeekNum(dt, 2) = Application.WeekNum(Sheets("日報表").[E2], 2) Then
  9.      For Each a In .Range(.[B2], .[B2].End(xlToRight))
  10.         w = a.Offset(-1, 0).MergeArea.Cells(1, 1)
  11.         d(w & a) = d(w & a) + .Cells(r, a.Column).Value
  12.      Next
  13.      End If
  14.      r = r + 1
  15.      dt = .Cells(r, 1)
  16.   Loop
  17.   End With
  18. Next
  19. With Sheets("日報表")
  20. For Each a In .[B15:B26]
  21. at = a
  22.    For Each b In .[P14:U14]
  23.       If b.Column > 18 Then at = ""
  24.       .Cells(a.Row, b.Column) = d(b & at)
  25.    Next
  26. Next
  27. End With
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 布施如播種，以歡喜心滋潤種子，才會發芽。
返回列表 上一主題