[發問] 請問如何將各筆數量，依日期範圍加總?

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-12-18

12^#

發表於 2020-3-27 11:46 | 只看該作者

回復 11# gaishutsusuru

若各類匯總結果固定最多6000筆, 可稍簡化:

Sub TEST()
Dim Arr, Brr, xD, r&, c%, i&, j&, k%, N&(2), Sr As Range
[O2:AP6000].Clear: Brr = [O2:AP6000]
Set xD = CreateObject("Scripting.Dictionary")
For Each Sr In [L2:M30]
k = 1 - k: If Sr <> "" Then xD(Sr & "/") = 2 - k
Next
'--------------------------------
Arr = Range([J1], Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
If IsDate(Arr(i, 3)) * IsDate(Arr(i, 3)) = 0 Then GoTo 101
c = xD(Arr(i, 2) & "/")
For j = Arr(i, 3) To Arr(i, 4) - 1
r = xD(j & "|" & c)
If r = 0 Then N(c) = N(c) + 1: r = N(c): xD(j & "|" & c) = r
Brr(r, c * 10 + 2) = CDate(j)
For k = 3 To 8: Brr(r, c * 10 + k) = Brr(r, c * 10 + k) + Arr(i, k + 2): Next k
Next j
101: Next i
'''--------------------------------
[O2:AP6000] = Brr
For Each Sr In Range("P2,Z2,AJ2")
Sr.Resize(6000, 7).Sort Key1:=Sr, Order1:=xlAscending, Header:=xlNo
Next
MsgBox "~~分類加總完成~~ "
End Sub

複製代碼

帖子: 146
主題: 46
精華: 0
積分: 220
點名: 0
作業系統: 7
軟體版本: 2010
閱讀權限: 20
註冊時間: 2014-2-19
最後登錄: 2023-8-31

11^#

發表於 2020-3-26 17:26 | 只看該作者

回復 10# 准提部林

謝謝准提大大的回覆，很感謝您的協助。

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-12-18

10^#

發表於 2020-3-26 17:11 | 只看該作者

回復 8# gaishutsusuru

已修改:

Xl0000054-2.rar (17.78 KB)

帖子: 146
主題: 46
精華: 0
積分: 220
點名: 0
作業系統: 7
軟體版本: 2010
閱讀權限: 20
註冊時間: 2014-2-19
最後登錄: 2023-8-31

9^#

發表於 2020-3-26 17:04 | 只看該作者

回復 7# Kubi

謝謝Kubi大大您的回覆哦，我先參考看看囉。

帖子: 146
主題: 46
精華: 0
積分: 220
點名: 0
作業系統: 7
軟體版本: 2010
閱讀權限: 20
註冊時間: 2014-2-19
最後登錄: 2023-8-31

8^#

發表於 2020-3-26 16:52 | 只看該作者

回復 6# 准提部林

謝謝准提大大的回覆，

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

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

再麻煩您抽空協助提供想法，謝謝您。

Kubi

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

7^#

發表於 2020-3-26 14:33 | 只看該作者

回復 5# gaishutsusuru
程式有點長，請參考。
注意：本程式碼無法照顧到你所說的例子(希望是以比較大的值去計)

活頁簿2.rar (25.21 KB)

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-12-18

6^#

發表於 2020-3-25 12:21 | 只看該作者

有點複雜, 自行參酌~~

Sub TEST()
Dim Arr, xD(3), d1, d2, i&, j&, k%, U%, Ur, Srr, xS As Worksheet
For j = 0 To 3: Set xD(j) = CreateObject("Scripting.Dictionary"): Next j
Arr = [L2:M30]
For j = 1 To 2: For i = 1 To UBound(Arr)
If Arr(i, j) <> "" Then xD(0)(Arr(i, j)) = j
Next: Next
'--------------------------------
Arr = Range([J1], Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
d1 = Arr(i, 3): d2 = Arr(i, 4)
If IsDate(d1) * IsDate(d2) = 0 Then GoTo 101
U = xD(0)(Arr(i, 2)) + 1
For j = d1 To d2 - 1
Ur = xD(U)(j)
If Not IsArray(Ur) Then Ur = Array(CDate(j), 0, 0, 0, 0, 0, 0)
For k = 5 To 10: Ur(k - 4) = Ur(k - 4) + Arr(i, k): Next k
xD(U)(j) = Ur
Next j
101: Next i
'--------------------------------
Srr = Array("", "一般", "特殊1", "特殊2")
For k = 1 To 3
With Sheets(Srr(k))
.UsedRange.Offset(1, 0).EntireRow.Delete
U = xD(k).Count: If U = 0 Then GoTo 102
With .[B2:H2].Resize(U)
.Value = Application.Transpose(Application.Transpose(xD(k).items))
.Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
End With
End With
102: Next k
End Sub

複製代碼

Xl0000054.rar (21.99 KB)

==============================

帖子: 146
主題: 46
精華: 0
積分: 220
點名: 0
作業系統: 7
軟體版本: 2010
閱讀權限: 20
註冊時間: 2014-2-19
最後登錄: 2023-8-31

5^#

發表於 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分鐘了，所以不能再進行更新。而關於問題，因為實際上的操作，需要再做進一步的處理，所以將問題新增在下方：

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

原始資料：(新增)
(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欄：各尺寸數量計算。

新的附檔：

活頁簿2.zip (15.65 KB)

真的不好意思，題目沒有立即更新上去。希望各位大大能再抽空協助，非常感謝。

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-12-18

4^#

發表於 2020-3-24 17:23 | 只看該作者

開始與結束日, 有否可能同一天???