Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,VBA½m²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (205.74 KB)

2023-11-29 07:16

°õ¦æµ²ªG:

¤U¸ü (261.23 KB)

2023-11-29 07:17

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