- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,VBA½m²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
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([¸ê®Æ®w!G1], [¸ê®Æ®w!A65536].End(3))
Crr = Range([·j´M!G1], [·j´M!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
[·j´M!I3].Resize(UBound(Crr) - 2, 3) = Crr
End Sub |
|