|
本帖最后由 chart888 于 2017-7-5 10:39 编辑
- Sub dd()
- Dim d As Object, Arr, Brr, Crr, i&, j&
- Set d = CreateObject("scripting.dictionary")
- On Error Resume Next
- Arr = [a1].CurrentRegion
- ReDim Brr(1 To UBound(Arr), 1 To 2)
- ReDim Crr(1 To UBound(Arr), 1 To 2)
- For i = 2 To UBound(Arr)
- d(Arr(i, 2)) = d(Arr(i, 2)) + 1
- Next
- For i = 2 To UBound(Arr)
- If d(Arr(i, 2)) > 1 Then
- k = k + 1
- Brr(k, 1) = Arr(i, 1)
- Brr(k, 2) = Arr(i, 2)
- ElseIf Left(Arr(i, 2), 9) <> Range("D8") Then
- j = j + 1
- Crr(j, 1) = Arr(i, 1)
- Crr(j, 2) = Arr(i, 2)
- End If
- Next
- [h2:i50000] = ""
- [h2].Resize(k, 2) = Brr
- [h1].Resize(k + 1, 2).Sort key1:=[h1], order1:=xlAscending, Header:=xlYes
- [h2].Offset(k, 0).Resize(j, 2) = Crr
- [h2].Offset(k, 0).Resize(j + 1, 2).Sort key1:=[h1].Offset(k, 0), order1:=xlAscending, Header:=xlYes
- Set d = Nothing
- End Sub
复制代码
这样试试呢 |
评分
-
查看全部评分
|