[已解决]如何提取不重复值，谢谢windyjw007老师的帮助！

lhj323323

老师

我在上传的附件中写有详细的说明，是关于某个标准，提取不重复值，先谢谢了

最佳答案

月排行榜 / 总排行榜

windyjw007

2017-8-6 15:23

试试！{:112:}

1. Sub tq()
   
2.     Dim d As Object
   
3.     Dim ar, br(1 To 10000, 1 To 3)
   
4.     Dim i As Long, j As Long
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     ar = Sheets("数据源").Cells(1, 1).CurrentRegion
   
7.     For i = 2 To UBound(ar)
   
8.         If ar(i, 15) > 0 Then
   
9.             If Not d.exists(ar(i, 19)) Then
   
10.                 d.Add ar(i, 19), ""
    
11.                 j = j + 1
    
12.                 br(j, 1) = "'" & Format(ar(i, 1), "000000")
    
13.                 br(j, 2) = ar(i, 2)
    
14.                 br(j, 3) = ar(i, 19)
    
15.             End If
    
16.         End If
    
17.     Next i
    
18.     With Sheets("结果表").Cells(2, 1)
    
19.         .Resize(Rows.Count - 1, 3).ClearContents
    
20.         .Resize(j, 3) = br
    
21.     End With
    
22. End Sub
    

复制代码

跳转到最佳答案楼层

windyjw007

试试！{:112:}

1. Sub tq()
   
2.     Dim d As Object
   
3.     Dim ar, br(1 To 10000, 1 To 3)
   
4.     Dim i As Long, j As Long
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     ar = Sheets("数据源").Cells(1, 1).CurrentRegion
   
7.     For i = 2 To UBound(ar)
   
8.         If ar(i, 15) > 0 Then
   
9.             If Not d.exists(ar(i, 19)) Then
   
10.                 d.Add ar(i, 19), ""
    
11.                 j = j + 1
    
12.                 br(j, 1) = "'" & Format(ar(i, 1), "000000")
    
13.                 br(j, 2) = ar(i, 2)
    
14.                 br(j, 3) = ar(i, 19)
    
15.             End If
    
16.         End If
    
17.     Next i
    
18.     With Sheets("结果表").Cells(2, 1)
    
19.         .Resize(Rows.Count - 1, 3).ClearContents
    
20.         .Resize(j, 3) = br
    
21.     End With
    
22. End Sub
    

复制代码

lhj323323

windyjw007 发表于 2017-8-6 15:23
试试！

谢谢windyjw007老师！