- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-7-25
|
本帖最後由 准提部林 於 2015-9-26 19:07 編輯
回復 3# mark761222
花個時間研究看看, 不難:(程式有部份修改)- Sub TEST()
- Dim R&, xD, Arr, Brr, j&, Jm&, T$, N&
- '↓清除之前的結果
- [L:O].ClearContents
- [L1:O1] = Array("日期", "樣式", "工作人員", "數量")
-
- '↓以A欄取得最後一筆〔列號〕
- R = Cells(Rows.Count, 1).End(xlUp).Row
- If R < 2 Then Exit Sub
-
- '↓將資料範圍設為陣列(含標題列)
- Arr = [A1:F1].Resize(R)
-
- '↓設一個空陣列,以接受結果
- ReDim Brr(1 To R, 1 To 4)
-
- '↓設一個字典檔,以唯一〔索引值〕收集相關數據
- Set xD = CreateObject("Scripting.Dictionary")
-
- For j = 2 To R
- '↓A&B欄文字合為〔索引值〕
- T = Arr(j, 1) & Arr(j, 2)
-
- '↓取出〔索引值〕在字典檔中所帶的〔序號〕,
- 這〔序號〕用來識別填入〔陣列〕的〔位置〕
- N = xD(T)
-
- '↓如果〔序號〕為0,表示是新的〔索引值〕,
- 將〔序號〕遞增1,再納入字典檔
- If N = 0 Then Jm = Jm + 1: xD(T) = Jm: N = Jm
-
- '↓填入〔日期.樣式〕
- Brr(N, 1) = Arr(j, 1): Brr(N, 2) = Arr(j, 2)
-
- '↓填入〔工作人員〕,InStr 用來判斷是否重覆
- If InStr(Brr(N, 3), Arr(j, 4)) = 0 Then
- Brr(N, 3) = Trim(Brr(N, 3) & " " & Arr(j, 4))
- End If
-
- '↓填入〔累計數量〕
- Brr(N, 4) = Brr(N, 4) + Val(Arr(j, 6))
- Next j
-
- '↓列出結果
- [L2:O2].Resize(Jm) = Brr
- End Sub
複製代碼 |
|