[已解决]求有关于相同数字的问题。

ywwl

可版主走了。

豆丁

Sub test()
Dim arr, i%, j%, k%, arrt()
Set d = CreateObject("scripting.dictionary")
arr = Range("d1:i" & [d65536].End(3).Row)
ReDim arrt(1 To UBound(arr) - 1)
For i = 1 To UBound(arr, 2)
    d(arr(1, i)) = ""
Next
For k = 2 To UBound(arr)
    For j = 1 To UBound(arr, 2)
        If d.exists(arr(k, j)) Then
            arrt(k - 1) = arrt(k - 1) + 1
        End If
    Next
Next
Range("k:k").ClearContents
[k2].Resize(UBound(arrt), 1) = Application.Transpose(arrt)
End Sub

ljzzlan

学习！！！