按颜色统计数据，求各位大师帮忙

水木清扬

如图：B列、C列为计算结果，颜色是随机的，不同颜色重新开始统计

盼盼198310

请测试附件

dajiashiren

做了个按颜色统计的函数，看可以吗？

水木清扬

盼盼198310 发表于 2022-1-19 20:10
请测试附件

基本OK谢谢，还有一列：B列：如果要给个计数的序号，怎么给呢？

水木清扬

dajiashiren 发表于 2022-1-19 20:13
做了个按颜色统计的函数，看可以吗？

谢谢，不过数据量太大，如果用手工函数多有不便

盼盼198310

请测试附件

准提部林

Sub TEST_A1()
Dim Arr, xR As Range, C1&, C2&, n&, S
Arr = Range([b1], [a65536].End(3))
For i = 1 To UBound(Arr) - 1
    Set xR = Cells(i + 1, 1)
    C2 = xR.Interior.ColorIndex
    If C2 <> C1 Then C1 = C2: S = 0: n = 0
    n = n + 1: S = S + xR: Arr(i, 1) = n: Arr(i, 2) = ""
    If xR(2).Interior.ColorIndex <> C1 Then Arr(i, 2) = S
Next
[b2].Resize(UBound(Arr) - 1, 2) = Arr
End Sub

水木清扬

盼盼198310 发表于 2022-1-19 20:26
请测试附件

大功造成，谢谢。

psxk3535

试试看行不，做练习，也希望能帮到别人

zglibk

1. Sub test()
   
2.     Dim Dic As Object, tt, ii%, n%, ss%
   
3. 
   
4.     Set Dic = CreateObject("Scripting.Dictionary")
   
5.     With Sheet1
   
6.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
7.    
   
8.         For i = 2 To r
   
9.             TmpColor = .Cells(i, 1).Interior.ColorIndex
   
10.             Dic(TmpColor) = ""
    
11.         Next
    
12.         For m = 0 To Dic.Count - 1
    
13.             ii = 1: tt = 0
    
14.             For n = 2 To r
    
15.                 If .Cells(n, 1).Interior.ColorIndex = Dic.keys()(m) Then
    
16.                     .Cells(n, 2) = ii
    
17.                     ii = ii + 1
    
18.                     tt = tt + .Cells(n, 1)
    
19.                     ss = n
    
20.                 End If
    
21.             Next
    
22.             .Cells(ss, 3) = tt
    
23.         Next
    
24.     End With
    
25. End Sub

复制代码