- 帖子
- 1429
- 主題
- 40
- 精華
- 0
- 積分
- 1453
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-5-18
|
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
資料表:
結果表 執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Y, R&, i&, j&, T$, T0$
Dim xR As Range, Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("工作表1"): Set Sh2 = Sheets("Output")
Set xR = Sh1.[A1].CurrentRegion: Brr = xR
For i = 2 To UBound(Brr)
T = Trim(Brr(i, 2))
If T = "" Then GoTo i01
If T Like "C### [A-Z]*" Then
R = R + 1
T0 = Split(T, " ")(0)
Y(T0 & "|r") = R: Y(T0 & "|n") = 1: Y(T0 & "|tt") = Brr(i, 3)
For j = 1 To 5: Brr(R, j) = Brr(i, j): Next
GoTo i01
End If
Y(T & "|n") = Y(T & "|n") + 1
Y(T & "|tt") = Y(T & "|tt") + Brr(i, 3)
Brr(Y(T & "|r"), 3) = Round(Y(T & "|tt") / Y(T & "|n"), 2)
Brr(Y(T & "|r"), 4) = Brr(Y(T & "|r"), 4) + Brr(i, 4)
Brr(Y(T & "|r"), 5) = Brr(Y(T & "|r"), 5) + Brr(i, 5)
i01:
Next
[5:65536].Clear
Sh2.[A5].Resize(R, 5) = Brr
Set Y = Nothing: Set xR = Nothing: Erase Brr
Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub |
|
發表於 2023-4-14 14:20
| 