- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-11-28
|
15#
發表於 2023-12-14 14:43
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖以1#範例練習陣列與字典,學習方案如下,請各位前輩指教
資料表:
結果表:
Option Explicit
Sub TEST()
Dim Brr, Crr(10, 11), Z, A, i&, R&, C%, T$, T3$, T4$, xR
'↑宣告變數
'Application.ScreenUpdating = False
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Brr = Range([資料庫!E2], [資料庫!A65536].End(3))
'↑令Brr變數是帶入範圍儲存格值的二維陣列
For i = 1 To UBound(Brr)
'↑設順迴圈!i從1到Brr陣列縱向最大索引列號
T3 = Trim(Brr(i, 3)): T4 = Trim(Brr(i, 4))
'↑令T3變數是i迴圈列第3欄Brr陣列值,令T4變數是i迴圈列第4欄Brr陣列值
If T3 = "" Or T4 = "" Then GoTo i01 Else T = T3 & "|" & T4
'↑如果規格或批號是空的!就跳到標示 i01位置繼續執行,
'否則就令T變數是以"|"符號連接T3與T4變數組成的新字串
A = Z(T): R = Z(T & "/r"): C = Z(T & "/c")
'↑令A變數是以T變數查Z字典回傳item值,
'令R變數是以T變數連接"/r"組成的新字串,查Z字典回傳item值
'令C變數是以T變數連接"/c"組成的新字串,查Z字典回傳item值
If Not IsArray(A) Then A = Crr: A(0, 0) = "批號": A(0, 1) = T3: R = 1: Z(T & "/規格") = "規格" & T4
'↑如果A變數不是陣列!就令A變數是Crr空陣列,令最左上角陣列值是 "批號"字串,
'令0列/1欄陣列值是T3變數(批號),令R變數是 1
'令T變數連接 "/規格"組成的新字串為key,item是 "規格"字串連接T4變數組成的新字串,納入Z字典中
C = C + 1
'↑令C變數累加 1
If C = 11 Then C = 1: R = R + 1
'↑如果C變數是 11,就令C=1,R+1 (陣列換行放結果值)
A(R, C) = Val(Brr(i, 5))
'↑令重量值放入陣列裡
Z(T & "/r") = R: Z(T & "/c") = C: Z(T) = A
'↑令列數與欄數紀錄在字典中
'令A二維陣列放回字典中
i01: Next
Sheets("報表").UsedRange.EntireRow.Delete
'↑令舊的結果刪除
Set xR = [報表!A1]
'↑令xR變數是物件 ("報表"工作表的[A1]儲存格)
For Each A In Z.KEYS
'↑設逐項迴圈!令A變數是 Z字典裡的key之一
If InStr(A, "/") Then GoTo A01 Else R = Z(A & "/r")
'↑如果A變數裡有包含"/"字元!就跳到標示A01位置繼續執行,否則就令R變數取出紀錄在Z字典的列數
With xR.Resize(R + 3, 12)
'↑以下是關於結果範圍儲存格的程序
.Value = Z(A)
'↑令該範圍儲存格值,以A變數查Z字典回傳的陣列值寫入
.Cells(R + 3, 1) = Z(A & "/規格"): .Cells(R + 3, 2) = "數量": .Cells(R + 3, 4) = "小計:"
'↑令該範圍儲存格最後列1,2,4欄儲存格寫入字串
.Cells(R + 3, 3) = "=COUNT(" & xR.Resize(R, 12).Offset(1).Address & ")"
'↑令該範圍儲存格最後列第3欄儲存格寫入 非空格的儲存格數公式=COUNT()
.Cells(R + 3, 5) = "=SUM(" & xR.Resize(R, 12).Offset(1).Address & ")"
'↑令該範圍儲存格最後列第5欄儲存格寫入 儲存格數值總和公式=SUM()
For i = 7 To 10: .Borders(i).Weight = 4: Next
'↑令該儲存格範圍最外圍設為粗格線
End With
Set xR = xR(R + 4, 1)
'↑令xR變數是下個結果範圍的第1格儲存格
A01: Next
End Sub |
|
