GBKEE

回復 10# olisun   
07# 程式碼中
Set Rng = .[j15:l26]  改成 Set Rng = .[Q15:Q26]
刪掉 11.                AD = AD - Evaluate("SUMIF(" & 工作表17.[A:A].Address(, , , 1) & ",""<" & d - (W - 1) & """, " & 工作表17.Columns(1 + (i * 12) + ii).Address(, , , 1) & ")")
就可以

olisun

可能有點誤會，因為原來的P15:P26是派報，Q15:Q26是夾報
在"派夾報宣傳車"中日期是A:A     派報是B:M    夾報是N:Y
所以我下列式子在P15:P26是對的，可是Q15:Q26我就不會設了
Private Sub CommandButton2_Click()
    With Sheets("日報表")
             Set c = Sheets("派夾報宣傳車").Range("a:a").Find(.[E2], lookat:=xlWhole)
              Arr = Sheets("派夾報宣傳車").[a3].Resize(c.Row - 2, 13)
        For i = 15 To 26
      Sheets("日報表").Range("p" & i).Value = Application.Sum(Application.Index(Arr, 0, i - 13))
            Next i
   End With
End Sub

Hsieh

回復 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

複製代碼

olisun

回復  olisun
累計區塊計算
Hsieh 發表於 2010-8-30 22:48

    答案有問題，如果我輸入日期是2010/8/5，前面有一筆是2010/8/4，後面一筆是2010/8/6，
他統計的是2010/8/4+2010/8/6，而不是2010/8/4+2010/8/5

Hsieh

回復 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

複製代碼

olisun

因為我套在我的式子裡，而我式子中有Dim d As Date這一句，所以我改成
Set g = CreateObject("Scripting.Dictionary")
但是出現型態不符合

olisun

上一個問題是我dim有加了一句dim g as range，改了之後又出現另一個
Set g = CreateObject("Scripting.Dictionary")
For Each sh In Sheets(Array("派夾報宣傳車", "NP、CF"))
With sh
R = 3
gt = .Cells(R, 1)
  Do Until gt > Sheets("日報表").[E2]
     For Each a In .Range(.[B2], .[B2].End(xlToRight))
        W = a.Offset(-1, 0).MergeArea.Cells(1, 1)     ----------- 型態不符
        g(W & a) = g(W & a) + .Cells(R, a.Column).Value
     Next
     R = R + 1
     dt = .Cells(R, 1)
  Loop
  End With
Next
With Sheets("日報表")
For Each a In .[B15:B26]
at = a
   For Each b In .[P14:U14]
      If b.Column > 18 Then at = ""
      .Cells(a.Row, b.Column) = g(b & at)
   Next
Next
End With

olisun

感謝，這次ok