[讨论]多列中查找重复值的最优方案

northwolves

仍有提速空间:

Sub macro1()
Dim arr, i As Long, j As Long, n As Long, b(1000000) As Long, t As Single
Application.ScreenUpdating = False
arr = [A1:C60000].Value
t = Timer
For i = 1 To 60000
b(arr(i, 1)) = 1
Next
For j = 2 To 3
For i = 1 To 60000
b(arr(i, j)) = b(arr(i, j)) * j
Next i, j
ReDim arr(1 To 600000, 1 To 1)
For i = 0 To 1000000
If b(i) > 0 Then If b(i) Mod 6 = 0 Then n = n + 1: arr(n, 1) = i
Next
[D1].Resize(n, 1) = arr
Application.ScreenUpdating = True
MsgBox Timer - t & "秒!"
End Sub

返回0.27s

Sub macro2()
Dim arr, i As Long, n As Long, b(1000000) As Byte, t As Single
Application.ScreenUpdating = False
arr = [A1:d60000]
t = Timer
For i = 1 To 60000
b(arr(i, 1)) = 1
Next

For i = 1 To 60000
If b(arr(i, 2)) = 1 Then b(arr(i, 2)) = 2
Next

For i = 1 To 60000
If b(arr(i, 3)) = 2 Then n = n + 1: arr(n, 4) = arr(i, 3)
Next
[D1].Resize(n, 1) = Application.Index(arr, 0, 4)
Application.ScreenUpdating = True
MsgBox Timer - t & "秒!"
End Sub

返回0.18s

oobird

更快，更直观，收下了。

彭希仁

QUOTE:

以下是引用northwolves在2007-10-25 22:00:58的发言：

仍有提速空间:

Sub macro1()
Dim arr, i As Long, j As Long, n As Long, b(1000000) As Long, t As Single
Application.ScreenUpdating = False
arr = [A1:C60000].Value
t = Timer
For i = 1 To 60000
b(arr(i, 1)) = 1
Next
For j = 2 To 3
For i = 1 To 60000
b(arr(i, j)) = b(arr(i, j)) * j
Next i, j
ReDim arr(1 To 600000, 1 To 1)
For i = 0 To 1000000
If b(i) > 0 Then If b(i) Mod 6 = 0 Then n = n + 1: arr(n, 1) = i
Next
[D1].Resize(n, 1) = arr
Application.ScreenUpdating = True
MsgBox Timer - t & "秒!"
End Sub

返回0.27s

Sub macro2()
Dim arr, i As Long, n As Long, b(1000000) As Byte, t As Single
Application.ScreenUpdating = False
arr = [A1:d60000]
t = Timer
For i = 1 To 60000
b(arr(i, 1)) = 1
Next

For i = 1 To 60000
If b(arr(i, 2)) = 1 Then b(arr(i, 2)) = 2
Next

For i = 1 To 60000
If b(arr(i, 3)) = 2 Then n = n + 1: arr(n, 4) = arr(i, 3)
Next
[D1].Resize(n, 1) = Application.Index(arr, 0, 4)
Application.ScreenUpdating = True
MsgBox Timer - t & "秒!"
End Sub

返回0.18s

的确，电脑做起加法来，比乘法要快得多。最慢的就是除法了。

AIEO.CN

乾坤倒转，思路奇妙，精采绝伦，真不是一般的狼

little-key

对于Sub macro2()这些，怎么使用啊？

maditate

QUOTE:

以下是引用little-key在2007-10-26 17:05:39的发言：
对于Sub macro2()这些，怎么使用啊？

打开Excel 按下Alt+F11 进入VBA编辑器，到了里面就随便搞吧。

[此贴子已经被作者于2007-10-26 17:12:49编辑过]

一束阳光

17楼，macro1()和macro2()得出来的数不一致。

macro1()得出158个结果，macro2()得出来159个。

smhf_6

macro2()与字典解法，我看思路基本相同，但数组解法是字典的10倍。

一束阳光

QUOTE:

以下是引用smhf_6在2007-10-27 14:16:29的发言：
macro2()与字典解法，我看思路基本相同，但数组解法是字典的10倍。

可以用数组解法解决我的问题吗？

问了好久了，没有得到最终答案。

http://club.excelhome.net/viewthread.php?tid=271717&extra=&page=1#271717

northwolves

QUOTE:

以下是引用一束阳光在2007-10-27 9:37:43的发言：

17楼，macro1()和macro2()得出来的数不一致。

macro1()得出158个结果，macro2()得出来159个。

macro2()没有考虑重复值的问题,取不重复即可:

Sub macro2()
Dim arr, i As Long, n As Long, b(1000000) As Byte, t As Single
Application.ScreenUpdating = False
arr = [A1:d60000]
t = Timer
For i = 1 To 60000
b(arr(i, 1)) = 1
Next

For i = 1 To 60000
If b(arr(i, 2)) = 1 Then b(arr(i, 2)) = 2
Next

For i = 1 To 60000
If b(arr(i, 3)) = 2 Then n = n + 1: arr(n, 4) = arr(i, 3)
Next
[e1].Resize(n, 1) = Application.Index(arr, 0, 4)
[e1].Resize(n, 1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Application.ScreenUpdating = True
MsgBox Timer - t & "秒!"
End Sub