按月份统计颜色出现的次数

usedrange

Sub tt()
    Dim arr, brr, dic, i%, d%, n%, mst$
    arr = Range("a2:b" & Range("a2").End(xlDown).Row)
    Set dic = CreateObject("scripting.dictionary")
    ReDim brr(1 To UBound(arr))
    For i = 1 To UBound(arr)
        d = Month(arr(i, 1))
        mst = d & arr(i, 2)
        dic(mst) = dic(mst) + 1
        brr(i) = Left(arr(i, 2), 1) & Format(dic(mst), "000")
    Next i
    Sheets("sheet1").Range("d2").Resize(UBound(brr), 1) = Application.Transpose(brr)
End Sub

gwjkkkkk

1. =LEFT(B2,1)&TEXT(COUNTIF(INDIRECT("E2:E"&ROW()),E2),"000")

复制代码

mfk1288

gwjkkkkk 发表于 2023-12-6 19:22

谢谢指导。第一，你这个公式的E列，E2，是什么？？我的表没有E列，另外还要考虑月份为条件，跨月又要重新统计了哟。

zhangcheng6688

mark,学习字典之后再来

680926

Sub t()
Dim arr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
   k = Month(arr(i, 1))
   d(k & "-" & arr(i, 2)) = d(k & "-" & arr(i, 2)) + 1
   Cells(i, 4) = Left(arr(i, 2), 1) & Format(d(k & "-" & arr(i, 2)), "000")
Next
End Sub

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   yf = Month(arr(i, 1))
   ys = Mid(arr(i, 2), 1, 1)
   ss = yf & ys
   d(ss) = d(ss) + 1
   arr(i, 3) = ys & Format(d(ss), "000")
Next
[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub

swl4561255

1. Sub 计数()
   
2. ar = Range("A1").End(4).Row
   
3. arr = Range("A2:B" & ar)
   
4. Dim brr()
   
5. Set d = CreateObject("scripting.dictionary")
   
6. For i = 1 To ar - 1
   
7.   m = m + 1
   
8.   ReDim Preserve brr(1 To m)
   
9.   d(Month(arr(i, 1)) & arr(i, 2)) = d(Month(arr(i, 1)) & arr(i, 2)) + 1
   
10.   brr(m) = Left(arr(i, 2), 1) & Format(d(Month(arr(i, 1)) & arr(i, 2)), "000")
    
11. Next
    
12. [D2].Resize(m, 1) = Application.Transpose(brr)
    
13. End Sub

复制代码