逗号符号隔开的数值，对比重复数量，

zhangtaobeijing

ahnyt 发表于 2020-6-30 14:20
测试，符合给鲜花。如果数据多了，那就换数组

老师，最后一答案，有误，只有3个数字相同。

曹亮120

看下是不是

zhangtaobeijing

yxbaju 发表于 2020-6-30 14:35

最后一个答案应该为3个数字相同，

1. Sub repeatnum()
   
2. Dim d, n, i
   
3. With Sheet1
   
4. Set d = CreateObject("scripting.dictionary")
   
5. For Each num In Split([d1], ",")
   
6.    d(num) = ""
   
7. Next
   
8. For i = 2 To Range("b2").End(xlDown).Row
   
9.    n = 0
   
10.    For Each num In Split(Cells(i, “b"), ",")
    
11.       If d.exists(num) Then n = n + 1
    
12.       Next
    
13.    Cells(i, "d") = n
    
14.    Next
    
15.    End With
    
16. End Sub
    

复制代码

zhangtaobeijing

曹亮120 发表于 2020-6-30 14:41
看下是不是

答案正确，但没看明白。假如我现在要换成从 [e2] 单元格开始输出，改哪里呀？

花儿为什么这样

使用正则表达式做，用了0.0625秒，代码见附件。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   Set d1 = CreateObject("scripting.dictionary")
   
9.   tt = Timer
   
10.   With Worksheets("sheet1")
    
11.     xm = Split(.Range("g1"), ",")
    
12.     For i = 0 To UBound(xm)
    
13.       d((xm(i))) = ""
    
14.     Next
    
15.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
16.     arr = .Range("b2:b" & r)
    
17.     ReDim brr(1 To UBound(arr), 1 To 1)
    
18.     For i = 1 To UBound(arr)
    
19.       d1.RemoveAll
    
20.       xm = Split(arr(i, 1), ",")
    
21.       For j = 0 To UBound(xm)
    
22.         If d.exists(xm(j)) Then
    
23.           d1(xm(j)) = ""
    
24.         End If
    
25.       Next
    
26.       brr(i, 1) = d1.Count
    
27.     Next
    
28.     .Range("d2").Resize(UBound(brr), 1) = brr
    
29.   End With
    
30.   Application.ScreenUpdating = True
    
31.   MsgBox "数据比对完毕，共用时" & Timer - tt & "秒"
    
32. End Sub
    

复制代码

chxw68

楼主的公式写得太好了。

一把小刀闯天下

'参与一下。效率应该不会差的，这点数据无法测试效率。可以拿10W条数据测试一下，，，

Option Explicit

Sub test()
  Dim arr, i As Long, j As Long, t, n As Long, temp() As Long, tm As Single
  tm = Timer
  ReDim pos(99) As Long
  t = Split([d1].Value, ",")
  For i = 0 To UBound(t)
    pos(t(i)) = 1
  Next
  arr = Range("b2:b" & Cells(Rows.Count, "b").End(xlUp).Row).Value
  ReDim brr(1 To UBound(arr, 1), 1 To 1) As Long
  For i = 1 To UBound(arr, 1)
    ReDim temp(99) As Long
    t = Split(arr(i, 1), ",")
    For j = 0 To UBound(t)
      n = t(j)
      If pos(n) = 1 Then
        If temp(n) = 0 Then
          temp(n) = 1: brr(i, 1) = brr(i, 1) + 1
        End If
      End If
    Next
  Next
  Debug.Print Timer - tm
  [d2].Resize(UBound(brr, 1)) = brr
  Debug.Print Timer - tm
End Sub

232670631

Sub tsx()
Dim ar, br, i%, j%, k, l, n
Dim d As Object
Set d = CreateObject("scripting.dictionary")
For i = 0 To 2
    d(Split(Cells(1, 4), ",")(i)) = ""
Next
'[h6].Resize(1, 3) = d.keys
ar = Range("b2:b21")
ReDim br(1 To UBound(ar), 1 To 1)
For i = 1 To UBound(ar)
    l = 0: ar(i, 1) = ar(i, 1) & ","
For j = 1 To Len(ar(i, 1))
    If IsNumeric(Mid(ar(i, 1), j, 1)) Then
        If Mid(ar(i, 1), j + 1, 1) = "," Then
            k = Mid(ar(i, 1), j, 1)
        Else
            k = Mid(ar(i, 1), j, 1) & Mid(ar(i, 1), j + 1, 1)
        End If
    End If
    If d.exists(k) Then
        l = l + 1
    End If
Next
    br(i, 1) = l / 2
Next
Range("d2").Resize(UBound(br), 1) = br
End Sub

ahnyt

zhangtaobeijing 发表于 2020-6-30 14:36
老师，最后一答案，有误，只有3个数字相同。

理解错了，看别的老师的吧