|
本帖最后由 laoau138 于 2017-6-21 15:11 编辑
用VBA数组或字典挑选相同
- Sub tt()
- arr = [a1].CurrentRegion
- Set d = CreateObject("scripting.dictionary")
- For i = 2 To UBound(arr)
- x = arr(i, 3)
- If Not d.exists(x) Then d(x) = i Else d(x) = d(x) & "," & i
- Next
- ReDim brr(1 To d.Count, 1 To 5)
- For Each x In d.keys
- If InStr(d(x), ",") > 0 Then
- krr = Split(d(x), ",")
- kmax = krr(UBound(krr)): kmin = krr(0)
- If arr(kmax, 2) <> arr(kmin, 2) Then
- n = n + 1: brr(n, 2) = "'" & x
- brr(n, 1) = arr(kmax, 2): brr(n, 3) = kmax
- brr(n, 4) = arr(kmin, 2): brr(n, 5) = kmin
- End If
- End If
- Next
- [e20].Resize(n, 5) = brr
- End Sub
复制代码
|
|