麻辣家族討論版版 - Powered by Discuz! Board

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

作者: olisun 時間: 2010-8-27 21:55 標題: 查詢統計以周為單位，真的有難度

輸入日期(不一定是當日的日期)，本日所查詢的即是所輸入的日期，我想要的是如何本週的統計
輸入查詢日期為8/20，則本周的統計為
8/16(一)～8/20(五)該週的累計
如果輸入查詢其為8/10，則本周的統計為
8/9(一)～8/10(二)該週的累計

作者: luhpro 時間: 2010-8-27 22:56

回復 1# olisun

你可以善用 Weekday() 函數(套用方式請找Excel VBA的說明)找到所輸入日期的星期數,
再以該星期數往前推算出該週週一的日期,
這樣你想要的資料就不難找到了喔.

作者: olisun 時間: 2010-8-27 23:47

回復 olisun

你可以善用 Weekday() 函數(套用方式請找Excel VBA的說明)找到所輸入日期的星期數,
再以 ...
luhpro 發表於 2010-8-27 22:56

可以再明確一點嗎

作者: luhpro 時間: 2010-8-28 00:17

Dim wkd%, wk1

  '所輸入日期的星期數
  wkd = Weekday(Range("E2"), vbMonday)
  '該週星期一的日期
  wk1 = DateAdd("d", -(wkd - 1), Range("E2"))

這樣有了你要的 "星期一" 的日期與所輸入的日期.

作者: GBKEE 時間: 2010-8-28 06:09

回復 3# olisun

Sub Ex()
Dim d As Date, W%
d = "2010/8/20"
W = Weekday(d, vbMonday) '週一為第1天
MsgBox "本週第1天 " & d - (W - 1) & " ** 本週第5天 " & d + (5 - W)
End Sub

複製代碼

作者: olisun 時間: 2010-8-28 11:48

本帖最後由 olisun 於 2010-8-28 12:16 編輯

若e2輸入的日期是2010/8/20
則
j15=sheets(派夾報宣傳車)中，b7+b8+b9+b10+b11=5份

作者: GBKEE 時間: 2010-8-28 11:50

回復 6# olisun
試試看

Private Sub Ex()
Dim d As Date, W%, AD, Rng As Range, i%, ii%
d = 工作表1.[E2]
W = Weekday(d, vbMonday) '週一為第1天
With 工作表1
.[j13] = "本週 " & d - (W - 1) & " ** " & d + (5 - W)
Set Rng = .[j15:l26]
For i = 0 To Rng.Columns.Count - 1
For ii = 1 To Rng.Rows.Count
AD = Evaluate("SUMIF(" & 工作表17.[A:A].Address(, , , 1) & ",""<=" & d + (5 - W) & """, " & 工作表17.Columns(1 + (i * 12) + ii).Address(, , , 1) & ")")
AD = AD - Evaluate("SUMIF(" & 工作表17.[A:A].Address(, , , 1) & ",""<" & d - (W - 1) & """, " & 工作表17.Columns(1 + (i * 12) + ii).Address(, , , 1) & ")")
Rng.Cells(ii, i + 1) = AD
Next
Next
Set Rng = .[M15:O15]
For i = 1 To Rng.Columns.Count
AD = Evaluate("SUMIF(" & 工作表18.[A:A].Address(, , , 1) & ",""<=" & d + (5 - W) & """, " & 工作表18.Columns(1 + i).Address(, , , 1) & ")")
AD = AD - Evaluate("SUMIF(" & 工作表18.[A:A].Address(, , , 1) & ",""<" & d - (W - 1) & """, " & 工作表18.Columns(1 + i).Address(, , , 1) & ")")
Rng.Cells(1, i) = AD
Next
End With
End Sub

複製代碼

作者: olisun 時間: 2010-8-28 12:15

回復 olisun
試試看
GBKEE 發表於 2010-8-28 11:50

如果以2010/8/20測試是ok的，但是如果以2010/8/15測試，答案是錯的?

作者: GBKEE 時間: 2010-8-28 13:43

回復 8# olisun
輸入查詢日期為8/20，則本周的統計為 8/16(一)～8/20(五) 該週的累計
如果輸入查詢其為8/10，則本周的統計為  8/9(一)～8/10(二)  該週的累計
你不是要一整週的日期間隔  而是要當週第一天到指定日期的天數  將程式碼紅色部分刪掉就可以
10.             AD = Evaluate("SUMIF(" & 工作表17.[A:A].Address(, , , 1) & ",""<=" & d + (5 - W) & """, " & 工作表17.Columns(1 + (i * 12) + ii).Address(, , , 1) & ")")

11.             AD = AD - Evaluate("SUMIF(" & 工作表17.[A:A].Address(, , , 1) & ",""<" & d - (W - 1) & """, " & 工作表17.Columns(1 + (i * 12) + ii).Address(, , , 1) & ")")

作者: olisun 時間: 2010-8-29 21:13 標題: Q15:Q26為E2所輸入日期以前的總和(已解決)

本帖最後由 olisun 於 2010-8-31 00:25 編輯

Q15

26為E2所輸入日期以前的總和
該怎麼設呢?

作者: GBKEE 時間: 2010-8-30 10:37

回復 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 時間: 2010-8-30 17:17

本帖最後由 Hsieh 於 2010-8-30 22:19 編輯

可能有點誤會，因為原來的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 時間: 2010-8-30 22:48

本帖最後由 Hsieh 於 2010-8-31 00:14 編輯

回復 13# olisun
累計區塊計算

Sub 累計()
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
Set d = CreateObject("Scripting.Dictionary") '建立字典物件
For Each sh In Sheets(Array("派夾報宣傳車", "NP、CF")) '在2個資料工作表循環
With sh
r = 3
dt = .Cells(r, 1) '資料工作表A欄的日期
Do Until dt > Sheets("日報表").[E2] '當日期超過就跳離迴圈
For Each a In .Range(.[B2], .[B2].End(xlToRight)) '資料工作表第2列做循環
w = a.Offset(-1, 0).MergeArea.Cells(1, 1) '第一列對應到的內容因為有合併儲存格所以取合併範圍第一格的值寫入變數
d(w & a) = d(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 = "" '因為18欄以後沒有地區所以要讓地區變數變空
.Cells(a.Row, b.Column) = d(b & at) '寫回日報表
Next
Next
End With
End Sub

複製代碼

作者: olisun 時間: 2010-8-30 22:59

回復 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 時間: 2010-8-30 23:15

本帖最後由 Hsieh 於 2010-8-30 23:31 編輯

回復 15# olisun
如果你敘述沒錯那就是筆誤多一行r=r+1(已修正)
如果是同一周累計

Sub 同周累計()
Set d = CreateObject("Scripting.Dictionary")
For Each sh In Sheets(Array("派夾報宣傳車", "NP、CF"))
With sh
r = 3
Do Until .Cells(r, 1) = "" 'Sheets("日報表").[E2]
dt = .Cells(r, 1)
If Year(dt) = Year(Sheets("日報表").[E2]) And Application.WeekNum(dt, 2) = Application.WeekNum(Sheets("日報表").[E2], 2) Then
For Each a In .Range(.[B2], .[B2].End(xlToRight))
w = a.Offset(-1, 0).MergeArea.Cells(1, 1)
d(w & a) = d(w & a) + .Cells(r, a.Column).Value
Next
End If
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) = d(b & at)
Next
Next
End With

複製代碼

作者: olisun 時間: 2010-8-30 23:40

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

作者: olisun 時間: 2010-8-30 23:46

上一個問題是我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 時間: 2010-8-31 00:24

感謝，這次ok

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)