- 帖子
- 406
- 主題
- 8
- 精華
- 0
- 積分
- 453
- 點名
- 0
- 作業系統
- WINDOWS 7
- 軟體版本
- 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2015-2-7
- 最後登錄
- 2021-7-31
|
4#
發表於 2018-11-24 18:23
| 只看該作者
本帖最後由 n7822123 於 2018-11-24 18:34 編輯
回復 3# n7822123
按下統計按鈕即可，我的電腦速度幾秒鐘即可完成
Sub 統計()
Dim Arr, 區首列, 區列數, d As Object
Dim 型號$, 日期$, 店名$, 類型$, Str$, 區首列串$, 區列數串$
Dim 日期起&, 日期終&, i%, R%, C%, Rn%, Cn%, 區數%
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
日期起 = [統計!D1]: 日期終 = [統計!F1]
類型 = [統計!H1]
'====輸入資料到字典，字典的Key依店名、型號做區分====
'==========依類型做篩選，並依日期加總==========
Sheets("數據來源").Activate
Arr = Range([C4], Cells(Rows.Count, 394).End(xlUp))
Rn = UBound(Arr): Cn = UBound(Arr, 2) - 1
For R = 3 To Rn: For C = 2 To Cn
店名 = Arr(1, C): 型號 = Arr(R, 1)
日期 = Arr(R, 392): Str = 店名 & "," & 型號
If Arr(2, C) = 類型 And 日期 >= 日期起 And 日期 <= 日期終 Then d(Str) = d(Str) + Arr(R, C)
Next: Next
'============輸出字典資料到統計工作表============
Sheets("統計").Activate
Rn = Cells(Rows.Count, 2).End(xlUp).Row
For R = 1 To Rn '先判斷出各小區(合併儲存格)的首列與列數
If Cells(R, 2) Like "*區" Then
區首列串 = 區首列串 & "," & R
區列數串 = 區列數串 & "," & Cells(R, 2).MergeArea.Rows.Count - 1 '扣掉小計列
區數 = 區數 + 1
End If
Next R
區首列 = Split(區首列串, ","): 區列數 = Split(區列數串, ",") '拆成陣列
Cn = [E4].End(2).Column - 4 '統計表要輸入資料的欄數
For i = 1 To 區數 '從字典比對key並輸出資料到相應欄列
Arr = Cells(區首列(i), 5).Resize(區列數(i), Cn)
For C = 1 To Cn: For R = 1 To 區列數(i)
店名 = Cells(R + 4, 4): 型號 = Cells(4, C + 4)
Arr(R, C) = d(店名 & "," & 型號)
Next R: Next C
Cells(區首列(i), 5).Resize(區列數(i), Cn) = Arr
Cells(Val(區首列(i)) + Val(區列數(i)), 5).Resize(, Cn) = "=sum(R[-" & 區列數(i) & "]C:R[-1]C)" '小計列公式(Sum.....)
Next i
End Sub
 test-1124.rar (914.48 KB)
|
|
發表於 2018-11-23 10:29
| 
