统计“Y”例相同数的个数有多少放入“X”例中谢谢！！

909459520

统计“Y”例相同数的个数有多少放入“X”例中谢谢！！

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, dic, t, crr
  Set dic = CreateObject("scripting.dictionary")
  arr = Range("y5:y" & Cells(Rows.Count, "y").End(xlUp).Row)
  ReDim brr(1 To UBound(arr, 1), 1 To 1)
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 1)) > 0 Then
      t = CDate(Round(arr(i, 1), 6))
      dic(t) = dic(t) + 1
    End If
  Next
  crr = Application.Transpose(Array(dic.keys, dic.items))
  For i = 1 To UBound(crr, 1) - 1
    For j = i + 1 To UBound(crr, 1)
      If crr(i, 1) > crr(j, 1) Then
        t = crr(i, 1): crr(i, 1) = crr(j, 1): crr(j, 1) = t
        t = crr(i, 2): crr(i, 2) = crr(j, 2): crr(j, 2) = t
      End If
  Next j, i
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 1)) > 0 Then
      t = CDate(Round(arr(i, 1), 6))
      brr(i, 1) = dic(t): dic.Remove (t)
    End If
  Next
  [x5].Resize(UBound(brr, 1)) = brr
  With [t5]
    .Resize(Rows.Count - 4, UBound(crr, 2)).ClearContents
    .Resize(UBound(crr, 1), UBound(crr, 2)) = crr
  End With
End Sub

909459520

一把小刀闯天下 发表于 2018-7-18 13:19
Option Explicit

Sub test()

请求高手再次帮忙，取较多值，谢谢！