如图数据
![](http://imgsrc.baidu.com/forum/w%3D580/sign=4d9578422ca446237ecaa56aa8237246/a4eef2d3572c11df895bbd1b6f2762d0f703c233.jpg)
代码都是自己最近学习VBA的心得,不一定最优秀的,请大家批评指正。代码如下:
Sub 颜色汇总()
Dim rn As Range, rng As Range, i&, j&, k&, n&, p&, s&, t&
Set rn = Cells(Rows.Count, "d")
For Each rng In Range([a1], rn.End(xlUp))
If rng.Interior.Color < 256 ^ 3 - 1 Then k = k + 1
Next
For j = 1 To k
Do
i = i + 1
t = Range([a1], rn.End(xlUp)).Item(i).Interior.Color
Loop Until t < 256 ^ 3 - 1
Cells(j + 1, "f").Interior.Color = t
Cells(j + 1, "f") = t
Next
Range("f2:f" & k + 1).RemoveDuplicates (1)
Range("f2:f" & k + 1).ClearContents
i = 2
Do
p = p + 1
Loop Until Cells(p + 1, "f").Interior.Color = 256 ^ 3 - 1
For i = 2 To p
For Each rng In Range([a1], rn.End(xlUp))
If rng.Interior.Color = Cells(i, "f").Interior.Color Then
n = n + 1
s = s + rng
End If
Next
Cells(i, "g") = n
Cells(i, "h") = s
n = 0
s = 0
Next
End Sub
![](http://imgsrc.baidu.com/forum/w%3D580/sign=4d9578422ca446237ecaa56aa8237246/a4eef2d3572c11df895bbd1b6f2762d0f703c233.jpg)
代码都是自己最近学习VBA的心得,不一定最优秀的,请大家批评指正。代码如下:
Sub 颜色汇总()
Dim rn As Range, rng As Range, i&, j&, k&, n&, p&, s&, t&
Set rn = Cells(Rows.Count, "d")
For Each rng In Range([a1], rn.End(xlUp))
If rng.Interior.Color < 256 ^ 3 - 1 Then k = k + 1
Next
For j = 1 To k
Do
i = i + 1
t = Range([a1], rn.End(xlUp)).Item(i).Interior.Color
Loop Until t < 256 ^ 3 - 1
Cells(j + 1, "f").Interior.Color = t
Cells(j + 1, "f") = t
Next
Range("f2:f" & k + 1).RemoveDuplicates (1)
Range("f2:f" & k + 1).ClearContents
i = 2
Do
p = p + 1
Loop Until Cells(p + 1, "f").Interior.Color = 256 ^ 3 - 1
For i = 2 To p
For Each rng In Range([a1], rn.End(xlUp))
If rng.Interior.Color = Cells(i, "f").Interior.Color Then
n = n + 1
s = s + rng
End If
Next
Cells(i, "g") = n
Cells(i, "h") = s
n = 0
s = 0
Next
End Sub