|
花了我2个小时,看下速度是否满意!- Sub xx1()
- Dim arr, n&, i&, d, brr, crr(), x&, j1&, j2&, j3&, j4&, j5&, y&, str$
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet1
- n = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("A11:F" & n)
- ReDim Preserve crr(1 To 6, 1 To 1)
- For i = 1 To 6
- crr(i, 1) = arr(1, i)
- Next
- x = 1
- For i = 2 To n - 10
- For k = 1 To x
- y = 0
- str = "|" & crr(1, k) & "|" & crr(2, k) & "|" & crr(3, k) & "|" & crr(4, k) & "|" & crr(5, k) & "|" & crr(6, k) & "|"
- For j = 1 To 6
- If InStr(str, "|" & arr(i, j) & "|") Then y = y + 1
- Next
- If y >= 5 Then Exit For
- Next
- If y < 5 Then
- x = x + 1
- ReDim Preserve crr(1 To 6, 1 To x)
- For j = 1 To 6
- crr(j, x) = arr(i, j)
- Next
- End If
- Next
- .Range("P11").Resize(x, 6) = Application.WorksheetFunction.Transpose(crr)
- End With
- End Sub
复制代码 |
评分
-
查看全部评分
|