如何快速删除一部车同一个人同一天重复的刷卡记录

a000000b

删除重复记录.rar (10.45 KB, 下载次数: 142)

2014-1-19 10:10 上传

点击文件名下载附件

a000000b

急，请高手帮忙！谢谢！

a000000b

因为数据太多了，有几十万条，一条一条看太慢了。

交叉点

F2=SUMPRODUCT(($A$2:A2=A2)*(INT($C$2:C2)=INT(C2))*($D$2:D2=D2))
向下复制公式。
然后按F列排序（也可以筛选），将排在一起的，不是1的行删除即可。

a000000b

非常感谢！我试一下。

a000000b

可以了，谢谢！
不然我看得眼花缭乱的。

CheryBTL

a000000b 发表于 2014-1-19 10:14
因为数据太多了，有几十万条，一条一条看太慢了。

几十万条呀？ 那即使使用VBA也会很慢的

CheryBTL

1. Sub 提取不重复的记录()
   
2.     Dim ar, re, d As Object
   
3.     Dim i As Long, cnt As Long, j As Integer
   
4.     ar = Sheets(1).Range("A1").CurrentRegion
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     ReDim re(1 To UBound(ar), 1 To UBound(ar, 2))
   
7.     For i = 2 To UBound(ar)
   
8.         If Not d.exists(ar(i, 1) & Format(ar(i, 3), "ee-mm-dd")) Then
   
9.             cnt = cnt + 1
   
10.             d(ar(i, 1) & Format(ar(i, 3), "ee-mm-dd")) = cnt
    
11.             For j = 1 To UBound(ar, 2)
    
12.                 re(cnt, j) = ar(i, j)
    
13.             Next j
    
14.         End If
    
15.     Next i
    
16.     Sheets(2).[a1].Resize(cnt, UBound(re, 2)) = re
    
17. End Sub
    

复制代码

a000000b

嗯，是的非常慢。
用交叉点帮忙写的公式分作几个表格。
非常感谢您！只是VBA我不会用。

xutianlin

1. Sub ksekfe()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. arr = Range("a2:e" & Range("a65536").End(xlUp).Row)
   
4. For i = 1 To UBound(arr)
   
5.     n = n + 1
   
6.     Cells(n + 1, "f") = arr(i, 1) & Format(arr(i, 3), "yyyy-mm-dd") & arr(i, 4)
   
7.     Next
   
8. brr = Range("a2:f" & Range("f65536").End(xlUp).Row)
   
9. For i = 1 To UBound(brr)
   
10.     d(brr(i, 6)) = Array(brr(i, 1), brr(i, 2), brr(i, 3), brr(i, 4), brr(i, 5))
    
11.     Next
    
12. Range("f2:f" & Range("f65536").End(xlUp).Row).Clear
    
13. Sheets("123").Range("a2").Resize(d.Count, 5) = Application.Transpose((Application.Transpose(d.items)))
    
14. End Sub

复制代码