'19楼附件。去重后结果数:961166,升序输出
'总用时8s左右,对不对就不知道了,自己可以比较一下
Option Explicit
Sub test()
Dim i As Long, m As Long, flag(1) As Boolean, cnt As Long
Dim arr(1 To 3 * 2 ^ 20, 1 To 2), t As Single
t = Timer
Call getvalue(arr, "a", m, 1)
Call getvalue(arr, "b", m, 1)
Call getvalue(arr, "d", m, 2)
Call qsort(arr, 1, m, 1, 2, 1)
For i = 1 To m
If arr(i, 2) = 1 Then flag(0) = True Else flag(1) = True
If arr(i, 1) <> arr(i + 1, 1) Then
If flag(0) And flag(1) = False Then cnt = cnt + 1: arr(cnt, 1) = arr(i, 1)
flag(0) = False: flag(1) = False
End If
Next
Debug.Print Timer - t, m, cnt
With [f:f]
.ClearContents
If cnt > 2 ^ 20 Then MsgBox cnt: Exit Sub
If cnt > 0 Then .Resize(cnt) = arr
End With
Debug.Print Timer - t, m, cnt
End Sub
Function getvalue(brr, s, m, n)
Dim arr, i As Long
arr = Range(s & "2:" & s & Cells(Rows.Count, s).End(xlUp).Row).Value
For i = 1 To UBound(arr, 1)
m = m + 1
brr(m, 1) = arr(i, 1): brr(m, 2) = n
Next
End Function
Function qsort(arr, first, last, left, right, key)
Dim i As Long, j As Long, k As Long, x, t
i = first: j = last: x = arr((first + last) \ 2, key)
While i <= j
While arr(i, key) < x: i = i + 1: Wend
While x < arr(j, key): j = j - 1: Wend
If i <= j Then
For k = left To right
t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
Next
i = i + 1: j = j - 1
End If
Wend
If first < j Then qsort arr, first, j, left, right, key
If i < last Then qsort arr, i, last, left, right, key
End Function
|