如何在一列数据中筛选出重复值并显示把重复值在另外一列单次显示出来

gxz312

如何在一列数据中筛选出重复值并显示把重复值在另外一列单次显示出来。用数组在数据量大的时候就会比较慢，EXCEL又是2021的版本，感谢哪位大佬看看有没办法？谢谢

太极拍天雄

练习一下...........！

半百

cnmlgb9998

1. =UNIQUE(FILTER(A2:A16,COUNTIF(A2:A16,A2:A16)>1))

复制代码

titi012

参与一下.......

1. Sub tt()
   
2. 
   
3. Dim Arr, Nrr(), x&, y&, N&
   
4. Arr = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
   
5. ReDim Nrr(1 To UBound(Arr) / 2, 1 To 1)
   
6. For x = 1 To UBound(Arr) - 1
   
7.     If Arr(x, 1) <> "" Then
   
8.         For y = x + 1 To UBound(Arr)
   
9.             If Arr(y, 1) Like Arr(x, 1) Then
   
10.                 N = N + 1
    
11.                 Nrr(N, 1) = Arr(x, 1)
    
12.                 Arr(y, 1) = ""
    
13.             End If
    
14.         Next y
    
15.     End If
    
16. Next x
    
17. Range("b2:b" & Rows.Count).Clear
    
18. Range("b2").Resize(N, 1) = Nrr
    
19. 
    
20. End Sub

复制代码

tanglf188

SQL语句，万条数据可以秒出，请参考

yynrzwh

Sub test()

Set d = CreateObject("scripting.dictionary")
ar = Range("a1", Cells(Rows.Count, 1).End(3))
ReDim br(1 To UBound(ar), 1 To 1)

For i = 2 To UBound(ar)
    s = ar(i, 1)
    If Not d.exists(s) Then
        d(s) = ""
    Else
        r = r + 1
        br(r, 1) = ar(i, 1)
    End If
Next

Range("b2").Resize(r) = br

Set d = Nothing
End Sub

gxz312

titi012 发表于 2024-4-26 15:16
参与一下.......

大佬，如果要显示在另外一张表格里怎么弄？研究了半天总是报错

zhangcheng6688

学习一下字典
Sub test()
lastr = Cells(Rows.Count, "a").End(xlUp).Row
arr = Range("a1:a" & lastr)
ReDim brr(1 To UBound(arr), 1 To 1)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   If Not d.exists(arr(i, 1)) Then
      d(arr(i, 1)) = ""
   Else
      m = m + 1
      brr(m, 1) = arr(i, 1)
   End If
Next
[b2].Resize(m, 1) = brr
End Sub

titi012

gxz312 发表于 2024-4-26 17:28
大佬，如果要显示在另外一张表格里怎么弄？研究了半天总是报错

参考一下下面的，
以数据在 Sheet1,写入到Sheet2为例
如果表名不同于上，按实际修改。

1. Sub tt()
   
2. 
   
3. Dim Arr, Nrr(), x&, y&, N&
   
4. Dim Wk As Workbook, xBoo As Boolean
   
5. 
   
6. Wk = ThisWorkbook
   
7. With Wk.Sheets("Sheet1")
   
8.     Arr = .Range("a2:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
   
9. End With
   
10. ReDim Nrr(1 To UBound(Arr) / 2, 1 To 1)
    
11. For x = 1 To UBound(Arr) - 1
    
12.     If Arr(x, 1) <> "" Then
    
13.         xBoo = False
    
14.         For y = x + 1 To UBound(Arr)
    
15.             If Arr(y, 1) Like Arr(x, 1) Then xBoo = True: Arr(y, 1) = ""
    
16.         Next y
    
17.         If xBoo Then N = N + 1: Nrr(N, 1) = Arr(x, 1)
    
18.     End If
    
19. Next x
    
20. With Wk.Sheets("Sheet2")
    
21.     .Range("b2:b" & Rows.Count).Clear
    
22.     .Range("b2").Resize(N, 1) = Nrr
    
23. End With
    
24. 
    
25. End Sub

复制代码