本帖最后由 一把小刀闯天下 于 2020-1-14 12:32 编辑
'还要总数,,,
Option Explicit
Sub test()
Dim arr, i, j, dic, m
Set dic = CreateObject("scripting.dictionary")
arr = range("k3:k" & Cells(Rows.Count, "k").End(xlUp).Row)
ReDim mark(2 To UBound(arr, 1))
j = 9
For i = 2 To UBound(mark)
j = j + 8: mark(i) = j
Next
For i = 1 To UBound(arr, 1)
If Len(arr(i, 1)) Then dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
arr = Application.Transpose(Array(dic.keys, dic.items, dic.items))
For i = 1 To UBound(arr, 1)
If arr(i, 2) <= 8 Then
arr(i, 3) = 1: m = m + 1
Else
For j = 2 To UBound(mark)
If arr(i, 2) <= mark(j) Then arr(i, 3) = j: m = m + 1: Exit For
Next
End If
Next
[ab1] = Format(m, "总数:0")
[z2].Resize(UBound(arr, 1), 3) = arr
End Sub
|