- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
13#
發表於 2023-3-31 10:00
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,添加最低價/最高價/均價,請各位前輩指教
執行結果:
Option Explicit
Sub TEST_1()
Dim Brr, Y, N&, S&, i&, j&, T&, T2&, T3&
Dim xR As Range, Ra As Range, Sh As Sheets
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([F1], Cells(Rows.Count, "A").End(xlUp))
Brr = xR: N = 1
For i = 2 To UBound(Brr)
T = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3)
If Y(T) = "" Then
N = N + 1: Y(T) = N: S = N: Brr(N, 1) = T: Brr(N, 3) = T3
Y(T & "|sd") = T2: Y(T & "|mi") = T2: Y(T & "|ma") = T2
Else
N = Y(T): Brr(N, 3) = Brr(N, 3) + T3
Y(T & "|mi") = IIf(T2 > Y(T & "|mi"), Y(T & "|mi"), T2)
Y(T & "|ma") = IIf(T2 < Y(T & "|ma"), Y(T & "|ma"), T2)
End If
Y(T & "|q") = Y(T & "|q") + T3: Y(T & "|tot") = Y(T & "|tot") + (T2 * T3)
Brr(N, 2) = T2 - Y(T & "|sd")
Brr(N, 4) = Y(T & "|mi"): Brr(N, 5) = Y(T & "|ma")
Brr(N, 6) = Y(T & "|tot") / Y(T & "|q")
Next
With xR.Offset(, 15)
.EntireColumn.ClearContents: .Resize(S, 6) = Brr
.Item(1, 4).Resize(1, 3) = [{"最低價","最高價","均價"}]
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub |
|
