第1个回答 2020-03-04
Sub nn()
Dim arr, brr, crr, r, i, j, zd As Object, m, n
r = [a65536].End(3).Row
arr = Range("a2:g" & r)
Set zd = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
arr(i, 5) = Val(Application.Substitute(Application.Substitute(arr(i, 5), "'", "."), """", ""))
zd(arr(i, 1)) = i
Next
ReDim drr(1 To zd.Count, 1 To 7)
brr = zd.items
crr = zd.keys
For j = 1 To zd.Count
n = brr(j - 1)
For i = 1 To UBound(arr)
If crr(j - 1) = arr(i, 1) And (arr(n, 7) < arr(i, 7) Or _
(arr(n, 7) = arr(i, 7) And arr(n, 5) > arr(i, 5))) Then
n = i
End If
drr(j, 1) = n
Next
Next
For i = 1 To zd.Count
m = drr(i, 1)
For j = 1 To 7
If j = 5 Then
drr(i, j) = Application.Substitute(Format(arr(m, j), "0.00"), ".", "'") & """"
Else
drr(i, j) = arr(m, j)
End If
Next
Next
Range("k1").Resize(1, 7) = [a1:g1].Value
Range("k2").Resize(UBound(drr), 7) = drr
MsgBox "筛选完成!", , "恭喜:"
End Sub本回答被提问者采纳