- 帖子
- 1517
- 主題
- 40
- 精華
- 0
- 積分
- 1541
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-10-31
|
7#
發表於 2023-11-29 07:18
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,VBA練習方案如下,請各位前輩指教
執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, Z1, A, i&, Q, T$, Ta$, Tb$, Tc$, Td$, Mi&, Ma&, ii&, Rp$
Set Arr = CreateObject("System.Collections.ArrayList")
Set Z = CreateObject("Scripting.Dictionary")
Set Z1 = CreateObject("Scripting.Dictionary")
Brr = Range([資料庫!G1], [資料庫!A65536].End(3))
Crr = Range([搜尋!G1], [搜尋!A65536].End(3))
Rp = Application.Rept(0, 9)
For i = 2 To UBound(Brr)
Ta = Trim(Brr(i, 1))
Tb = Format(Val(Brr(i, 2)), Rp)
Tc = Trim(Brr(i, 3))
Td = Format(Val(Brr(i, 4)), Rp)
T = Ta & Tb & Tc & "|" & Td
Z(T) = i: T = Ta & Tb & Tc
Z1(T & "|Ma") = IIf(Z1(T & "|Ma") < Val(Td), Val(Td), Z1(T & "|Ma"))
Z1(T & "|Mi") = IIf(Z1(T & "|Mi") = 0, Z1(T & "|Ma"), IIf(Z1(T & "|Mi") > Val(Td), Val(Td), Z1(T & "|Mi")))
Next
For i = 3 To UBound(Crr)
Ta = Trim(Crr(i, 1))
Tb = Format(Val(Crr(i, 2)), Rp)
Tc = Trim(Crr(i, 3))
Td = Format(Val(Crr(i, 4)), Rp)
T = Ta & Tb & Tc & "|" & Td
Z(T) = Z(T): Crr(i, 1) = T
Next
For Each A In Z.Keys
If A <> vbNullString And Not Arr.contains(A) Then Arr.Add (A)
Next
Arr.Sort: Arr = Arr.toarray
For i = 0 To UBound(Arr)
Q = Split(Arr(i), "|"): V = Val(Q(1))
If T <> Q(0) Then T = Q(0)
Mi = Z1(Q(0) & "|Mi"): Ma = Z1(Q(0) & "|Ma")
If V <= Mi Then Z(Arr(i)) = Z(T & "|" & Format(Mi, Rp)): GoTo i02
If V >= Ma Then Z(Arr(i)) = Z(T & "|" & Format(Ma, Rp)): GoTo i02
For ii = i + 1 To UBound(Arr)
If Z(Arr(ii)) <> "" Then Z(Arr(i)) = Z(Arr(ii)): Exit For
Next
i02: Next
For i = 3 To UBound(Crr)
Crr(i - 2, 3) = Brr(Z(Crr(i, 1)), 7)
Crr(i - 2, 2) = Brr(Z(Crr(i, 1)), 6)
Crr(i - 2, 1) = Brr(Z(Crr(i, 1)), 5)
Next
[搜尋!I3].Resize(UBound(Crr) - 2, 3) = Crr
End Sub |
|
發表於 2021-2-9 10:16
| 
