Board logo

標題: [發問] 請問如何將各筆數量，依日期範圍加總? [打印本頁]
作者: gaishutsusuru    時間: 2020-3-24 15:13     標題: 請問如何將各筆數量，依日期範圍加總?

本帖最後由 gaishutsusuru 於 2020-3-24 15:19 編輯

各位大大您好，想請各位協助幫忙以下這個問題：

[attach]31811[/attach]
(圖片中僅是示意部份。完整的資料，請再參考附檔)

原始資料：
(1) A欄：位置。A2~A79：固定不變的。
(2) B欄：種類。B2~B79：資料會變，但與這次詢問問題無關。
(3) C欄：開始日期。
(4) D欄：結束日期。
(5) E~J欄：各尺寸數量。(為了方便，將同一筆資料的數量設為相同。不同筆資料的數量設為1~31。但實際上數量會是完全不同的)

-----
處理後呈現：
(1) N欄：列出日期。以C欄(最早開始日期)為始，至D欄(最晚結束日期)為末。
(2) O欄~T欄：各尺寸數量計算。
* 將所有在日期範圍裡的數量加總，填在對應的日期裡。
* 說明1：
1_1        5E        2020/2/28        2020/3/6      (SS→XXL)的數量是1
1_1        3C        2020/3/6        2020/3/25   (SS→XXL)的數量是2
計算時，「數量：1」只需要計算到2020/3/5；從2020/3/6開始則是計算「數量：2」
也就是說，每筆資料在計算時，不會包含到結束日期。

* 說明2：
2020/2/20的數量：是由「1_3        1A        2020/2/18        2020/2/27」、「2_1        9I        2020/2/20        2020/3/7」、「3_2        6F        2020/2/20        2020/3/3」，這三筆的資料6、15、28加總而成的。(SS→XXL數量皆同，是因為方便計算，實際上各尺寸的數量是完全不同的。)
(以而附檔中因為我是手動一筆一筆去寫的，所以會看到是「=6+15+28」的呈現，但希望可以直接顯示加總後的值就可以了)
------
附檔：[attach]31812[/attach]

附上附檔，再拜託各位大大，抽空協助提供想法，謝謝您們。
(如對發問有任何疑問，請再留言，我將會回覆，謝謝。)
作者: Kubi    時間: 2020-3-24 16:40

執行後發現
3/21我的數據是185
3/25我的數據是106
不知是哪邊出了問題？
作者: gaishutsusuru    時間: 2020-3-24 16:56

回復 2# Kubi

謝謝您的回覆，不好意思，因為是手動輸入，所以出現2筆錯誤的資料，但您的值是正確的喔。

3/21我的數據是185
您是對的，因為我手動輸入時，把「3_1        15O        2020/3/13        2020/3/21」的值「27」誤植進去了。

3/25我的數據是106
您是對的，因為我手動輸入時，把「1_1        3C        2020/3/6        2020/3/25」的值「2」誤植進去了。
作者: 准提部林    時間: 2020-3-24 17:23

開始與結束日, 有否可能同一天???
作者: gaishutsusuru    時間: 2020-3-24 21:55

本帖最後由 gaishutsusuru 於 2020-3-24 21:58 編輯

回復 4# 准提部林

准提大大您好，

您說的情況一般來說是不會發生的，但如果像下面這個例子的話：
例：
第一筆 2020/4/1 2020/4/1：6
第二筆 2020/4/1 2020/4/5 ：3
則2020/4/1希望是以比較大的值去計：6

-----
另外，想再麻煩准提大大與各位版上大大，因為帖子已發帖經過15分鐘了，所以不能再進行更新。而關於問題，因為實際上的操作，需要再做進一步的處理，所以將問題新增在下方：

[attach]31813[/attach]
(圖片中僅是示意部份。完整的資料，請再參考附檔)

原始資料：(新增)
(6) L欄：特殊1。亦即將B欄(種類)手動挑出來歸類在特殊1。 (資料範圍：L2~L20)
(7) M欄：特殊2。亦即將B欄(種類)手動挑出來歸類在特殊2。 (資料範圍：M2~M20)
--
處理後呈現：(更改：從原本1個表更改成3個表)
1. 一般
B欄種類裡，排除「特殊1」、「特殊2」以外的，都歸類在「一般」。(而B欄的種類目前是列到15種，但實際上可能會變多)
(1) O欄：一般
(2) P欄：列出日期。以種類符合「一般」的，列出從C欄(最早開始日期)為始，至D欄(最晚結束日期)為末。
(3) Q欄~V欄：各尺寸數量計算。

2. 特殊1
(1) Y欄：特殊1
(2) Z欄：列出日期。以種類符合「特殊1」的，列出從C欄(最早開始日期)為始，至D欄(最晚結束日期)為末。
(3) AA欄~AF欄：各尺寸數量計算。

3. 特殊2
(1) AI欄：特殊2
(2) AJ欄：列出日期。以種類符合「特殊2」的，列出從C欄(最早開始日期)為始，至D欄(最晚結束日期)為末。
(3) AK欄~AP欄：各尺寸數量計算。

新的附檔：[attach]31814[/attach]

真的不好意思，題目沒有立即更新上去。希望各位大大能再抽空協助，非常感謝。
作者: 准提部林    時間: 2020-3-25 12:21

有點複雜, 自行參酌~~

  1. Sub TEST()
  2. Dim Arr, xD(3), d1, d2, i&, j&, k%, U%, Ur, Srr, xS As Worksheet
  3. For j = 0 To 3: Set xD(j) = CreateObject("Scripting.Dictionary"): Next j
  4. Arr = [L2:M30]
  5. For j = 1 To 2: For i = 1 To UBound(Arr)
  6.     If Arr(i, j) <> "" Then xD(0)(Arr(i, j)) = j
  7. Next: Next
  8. '--------------------------------
  9. Arr = Range([J1], Cells(Rows.Count, 1).End(xlUp))
  10. For i = 2 To UBound(Arr)
  11.     d1 = Arr(i, 3): d2 = Arr(i, 4)
  12.     If IsDate(d1) * IsDate(d2) = 0 Then GoTo 101
  13.     U = xD(0)(Arr(i, 2)) + 1
  14.     For j = d1 To d2 - 1
  15.         Ur = xD(U)(j)
  16.         If Not IsArray(Ur) Then Ur = Array(CDate(j), 0, 0, 0, 0, 0, 0)
  17.         For k = 5 To 10: Ur(k - 4) = Ur(k - 4) + Arr(i, k): Next k
  18.         xD(U)(j) = Ur
  19.     Next j
  20. 101: Next i
  21. '--------------------------------
  22. Srr = Array("", "一般", "特殊1", "特殊2")
  23. For k = 1 To 3
  24.     With Sheets(Srr(k))
  25.          .UsedRange.Offset(1, 0).EntireRow.Delete
  26.          U = xD(k).Count: If U = 0 Then GoTo 102
  27.          With .[B2:H2].Resize(U)
  28.               .Value = Application.Transpose(Application.Transpose(xD(k).items))
  29.               .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
  30.          End With
  31.     End With
  32. 102: Next k
  33. End Sub
複製代碼


[attach]31815[/attach]


==============================
作者: Kubi    時間: 2020-3-26 14:33

回復 5# gaishutsusuru
程式有點長，請參考。
注意：本程式碼無法照顧到你所說的例子(希望是以比較大的值去計)
[attach]31818[/attach]
作者: gaishutsusuru    時間: 2020-3-26 16:52

回復 6# 准提部林


謝謝准提大大的回覆，

您的檔案測試後，資料是分別顯示在3個工作表裡

想請問該怎麼用，才可以全部顯示在「工作表1」裡面呢?(如同我附檔裡的一樣，都顯示在工作表1裡面)

再麻煩您抽空協助提供想法，謝謝您。
作者: gaishutsusuru    時間: 2020-3-26 17:04

回復 7# Kubi


謝謝Kubi大大您的回覆哦，我先參考看看囉。
作者: 准提部林    時間: 2020-3-26 17:11

回復 8# gaishutsusuru


已修改:
[attach]31820[/attach]
作者: gaishutsusuru    時間: 2020-3-26 17:26

回復 10# 准提部林


  謝謝准提大大的回覆，很感謝您的協助。
作者: 准提部林    時間: 2020-3-27 11:46

回復 11# gaishutsusuru

若各類匯總結果固定最多6000筆, 可稍簡化:
  1. Sub TEST()
  2. Dim Arr, Brr, xD, r&, c%, i&, j&, k%, N&(2), Sr As Range
  3. [O2:AP6000].Clear: Brr = [O2:AP6000]
  4. Set xD = CreateObject("Scripting.Dictionary")
  5. For Each Sr In [L2:M30]
  6.     k = 1 - k: If Sr <> "" Then xD(Sr & "/") = 2 - k
  7. Next
  8. '--------------------------------
  9. Arr = Range([J1], Cells(Rows.Count, 1).End(xlUp))
  10. For i = 2 To UBound(Arr)
  11.     If IsDate(Arr(i, 3)) * IsDate(Arr(i, 3)) = 0 Then GoTo 101
  12.     c = xD(Arr(i, 2) & "/")
  13.     For j = Arr(i, 3) To Arr(i, 4) - 1
  14.         r = xD(j & "|" & c)
  15.         If r = 0 Then N(c) = N(c) + 1: r = N(c): xD(j & "|" & c) = r
  16.         Brr(r, c * 10 + 2) = CDate(j)
  17.         For k = 3 To 8: Brr(r, c * 10 + k) = Brr(r, c * 10 + k) + Arr(i, k + 2): Next k
  18.     Next j
  19. 101: Next i
  20. '''--------------------------------
  21. [O2:AP6000] = Brr
  22. For Each Sr In Range("P2,Z2,AJ2")
  23.     Sr.Resize(6000, 7).Sort Key1:=Sr, Order1:=xlAscending, Header:=xlNo
  24. Next
  25. MsgBox "~~分類加總完成~~  "
  26. End Sub
複製代碼




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