|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
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
|
|