通过vba根据单元格填充颜色统计个数

yinss05180

vba代码如下：

1. Sub Count()
   
2. 
   
3. Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, x, y As Long   '定义数据类型
   
4. 
   
5. a = Worksheets("Sheet1").Range("N4").Interior.Color   '将N4单元格的颜色值赋给a
   
6. 
   
7. b = Worksheets("Sheet1").Range("N5").Interior.Color   '将N5单元格的颜色值赋给b
   
8. 
   
9. c = Worksheets("Sheet1").Range("N6").Interior.Color   '将N6单元格的颜色值赋给c
   
10. 
    
11. d = Worksheets("Sheet1").Range("N7").Interior.Color   '将N7单元格的颜色值赋给d
    
12. 
    
13. e = Worksheets("Sheet1").Range("N8").Interior.Color   '将N8单元格的颜色值赋给e
    
14. 
    
15. f = Worksheets("Sheet1").Range("N9").Interior.Color   '将N9单元格的颜色值赋给f
    
16. 
    
17. g = Worksheets("Sheet1").Range("N10").Interior.Color   '将N10单元格的颜色值赋给g
    
18. 
    
19. h = 0    '对h进行初始化赋值
    
20. 
    
21. i = 0    '对i进行初始化赋值
    
22. 
    
23. j = 0    '对j进行初始化赋值
    
24. 
    
25. k = 0    '对k进行初始化赋值
    
26. 
    
27. l = 0    '对l进行初始化赋值
    
28. 
    
29. m = 0    '对m进行初始化赋值
    
30. 
    
31. n = 0    '对n进行初始化赋值
    
32. 
    
33. For x = 4 To 27    '从第4行到27行进行循环执行
    
34. 
    
35. For y = 2 To 12      '从第2列到第12列进行循环执行
    
36. 
    
37.                     '查找的范围相当于B4:L27
    
38. 
    
39. If Worksheets("Sheet1").Cells(x, y).Interior.Color = a Then
    
40. 
    
41. h = h + 1    '如果找到的单元格颜色与N4单元格相同，则加1
    
42. 
    
43. Worksheets("Sheet1").Range("P4") = c  '将结果输出到Sheet1表格的P4单元格
    
44. 
    
45. End If
    
46. 
    
47. 
    
48. If Worksheets("Sheet1").Cells(x, y).Interior.Color = b Then
    
49. 
    
50. i = i + 1    '如果找到的单元格颜色与N5单元格相同，则加1
    
51. 
    
52. Worksheets("Sheet1").Range("P5") = c  '将结果输出到Sheet1表格的P4单元格
    
53. 
    
54. End If
    
55. 
    
56. 
    
57. If Worksheets("Sheet1").Cells(x, y).Interior.Color = c Then
    
58. 
    
59. j = j + 1    '如果找到的单元格颜色与N6单元格相同，则加1
    
60. 
    
61. Worksheets("Sheet1").Range("P6") = c  '将结果输出到Sheet1表格的P4单元格
    
62. 
    
63. End If
    
64. 
    
65. 
    
66. If Worksheets("Sheet1").Cells(x, y).Interior.Color = d Then
    
67. 
    
68. k = k + 1    '如果找到的单元格颜色与N7单元格相同，则加1
    
69. 
    
70. Worksheets("Sheet1").Range("P7") = c  '将结果输出到Sheet1表格的P4单元格
    
71. 
    
72. End If
    
73. 
    
74. 
    
75. If Worksheets("Sheet1").Cells(x, y).Interior.Color = e Then
    
76. 
    
77. l = l + 1    '如果找到的单元格颜色与N8单元格相同，则加1
    
78. 
    
79. Worksheets("Sheet1").Range("P8") = c  '将结果输出到Sheet1表格的P4单元格
    
80. 
    
81. End If
    
82. 
    
83. 
    
84. If Worksheets("Sheet1").Cells(x, y).Interior.Color = f Then
    
85. 
    
86. m = m + 1    '如果找到的单元格颜色与N9单元格相同，则加1
    
87. 
    
88. Worksheets("Sheet1").Range("P9") = c  '将结果输出到Sheet1表格的P4单元格
    
89. 
    
90. End If
    
91. 
    
92. 
    
93. If Worksheets("Sheet1").Cells(x, y).Interior.Color = g Then
    
94. 
    
95. n = n + 1    '如果找到的单元格颜色与N10单元格相同，则加1
    
96. 
    
97. Worksheets("Sheet1").Range("P10") = c  '将结果输出到Sheet1表格的P4单元格
    
98. 
    
99. End If
    
100. 
     
101. 
     
102. 
     
103. Next
     
104. 
     
105. Next
     
106. 
     
107. End Sub
     

复制代码

但是计算出来的结果。。。不是想要的     求助

yinss05180

山菊花

供参考：

1. Sub 户数()
   
2.     Dim nR1%, Arr(), nR2%,  n%
   
3.     nR1 = Range("o3").End(xlDown).Row
   
4.     Dim ds As Object
   
5.     Set ds = CreateObject("Scripting.Dictionary")
   
6.     ReDim Arr(4 To nR1, 1 To 1) '声明一个数组，保存统计结果
   
7.     For i = 4 To nR1
   
8.         ds(Range("n" & i).Interior.Color) = i '将N列区域中的样本颜色值保存到字典备查
   
9.     Next
   
10.    
    
11.     nR2 = Range("a4").End(xlDown).Row
    
12.    
    
13.     For i = 4 To nR2 '循环数据区域所有行
    
14.         For j = 2 To 12 '循环各列
    
15.             n = ds(Cells(i, j).Interior.Color) '查字典，获得当前颜色对应的行号
    
16.             If n > 0 Then
    
17.                 Arr(n, 1) = Arr(n, 1) + 1 '按颜色累加户数
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     Range("p4:p" & nR1).Value = Arr '将统计结果输出到工作表
    
22.    
    
23. End Sub

复制代码