[已解决]提取重复中的不重复数据

sayloveyou2010 · 发表于 2014-5-4 16:20

写完了，好长好长 {:281:} 晚上师傅帮我讲另一种思路

复制代码

sayloveyou2010 · 发表于 2014-5-6 11:03

不要嫌我啰嗦啊嘿嘿，这个题我也学到了很多，给你看下另外两种方法，船长那个思路的速度最快
方法二思路：先排序，再循环判断

复制代码

方法三思路：双字典单循环（船长提供）

Sub 提取重复数据中的不重复记录3()
Dim dic1 As Object, dic2 As Object, Arr(), Brr(), MyR&, MyC%, k&, T
T = Timer
Application.ScreenUpdating = False
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
Arr = Sheets("基本信息").Range("b1:d" & Sheets("基本信息").Cells(Rows.Count, 4).End(xlUp).Row).Value
ReDim Brr(1 To UBound(Arr), 1 To 3)
For MyR = 1 To UBound(Arr)
If dic1.Exists(Arr(MyR, 3)) Then
If Not dic2.Exists(Arr(MyR, 3)) Then '重复中出现第一次
k = k + 1
For MyC = 1 To 3
Brr(k, MyC) = Arr(MyR, MyC)
Next MyC
dic2(Arr(MyR, 3)) = ""
End If
Else
dic1(Arr(MyR, 3)) = ""
End If
Next MyR
Sheets("重复").Range("b2").Resize(k, 3) = Brr
Application.ScreenUpdating = True
MsgBox "用时：" & Format(Timer - T, "0.00秒")
End Sub

复制代码

张雄友 · 发表于 2014-5-6 12:52

sayloveyou2010 发表于 2014-5-6 11:03
不要嫌我啰嗦啊嘿嘿，这个题我也学到了很多，给你看下另外两种方法，船长那个思路的速度最快
方法二思路： ...

怎么可能，谢谢你才对。

sayloveyou2010 · 发表于 2014-5-6 13:52

{:1712:}

香川群子 · 发表于 2014-5-6 15:42

算法最好、速度最快的代码在这里：

复制代码

仅比较计算部分，速度比2楼和船长的代码要快1倍。

但由于输出耗时较多，整个代码的耗时差异不大。

另，生成5万个重复模拟数据的代码如下：

Sub test()
m = 50000
ReDim a(1 To m, 1 To 3)
Do
t1 = ChrW(Int(Rnd * 1000) + 20000) & ChrW(Int(Rnd * 5000) + 20000) & ChrW(Int(Rnd * 5000) + 20000)
t2 = Format(Int(Rnd * 1000000), "000000") & Format(Date - 20000 + Int(Rnd * 20000), "yyyymmdd") & Format(Int(Rnd * 10000), "0000")
r = Int(Rnd * 1000)
For i = 100 To IIf(r < 100, 100, r)
k = k + 1
a(k, 1) = Int(Rnd * 500000)
a(k, 2) = t1
a(k, 3) = t2
If k = m Then Exit Do
Next
Loop
[b2].Resize(m, 3) = a
[b2].Resize(m, 3).Sort [b2], 1, , , 2
End Sub

复制代码

香川群子 · 发表于 2014-5-6 21:55

张熊友你的词汇也太贫乏了……只会“很给力”三个字么？

张雄友 · 发表于 2014-5-6 22:01

香川群子发表于 2014-5-6 21:55
张熊友你的词汇也太贫乏了……只会“很给力”三个字么？

不好意思，我语文从来不及格的，只有这水平，但是你就不同了，以你的知识完全可以进中科院了。

xupei355 · 发表于 2014-5-6 22:51

VBA不懂学习中

		自动登录	找回密码
密码			注册