Option Explicit
Sub TEST()
Dim Brr, V&, Z, i&, R&, N&
Set Z = CreateObject("Scripting.Dictionary")
Brr = [B1].CurrentRegion
[G2].Resize(ActiveSheet.UsedRange.Rows.Count, 2).ClearContents
V = Val([E2])
For i = 2 To UBound(Brr)
N = Z(Brr(i, 2)) + 1: Z(Brr(i, 2)) = N
If N <= V Then
R = R + 1
Brr(R, 1) = Brr(i, 1)
Brr(R, 2) = Brr(i, 2)
End If
Next
If R > 0 Then [G2].Resize(R, 2) = Brr
End Sub
發表於 2025-11-18 08:10
| 
