[已解决]求表格中数星星程序

棋行天下黄

急求表格中数星星程序，领导开会每周对各门店的各工作项评星，有红星，黑星，且前面有数字表示星的数量，表很多人做，红与黑的颜色不是完全统一，如有的人用深红，有的用粉红，如何电脑全自动统计黑星及红星的数量，要完整代码，谢谢！具体看模板中第一行数据统计是对的，其余统计都是错的！

最佳答案

月排行榜 / 总排行榜

冠军欧洲2010

2014-3-12 22:01

1. Sub A()
   
2.     Dim RG As Range
   
3.     Dim X, Y
   
4.     Dim 红, 黑
   
5.     For Each RG In Range("B3:P23")
   
6.         If RG.Characters(1, 3).Font.ColorIndex > 0 Then
   
7.             RG.Characters(1, 3).Font.ColorIndex = 3
   
8.         Else
   
9.             RG.Characters(1, 3).Font.ColorIndex = -4105
   
10.         End If
    
11.     Next
    
12.     For X = 3 To 23
    
13.         For Y = 2 To 15
    
14.             If Cells(X, Y).Characters(1, 3).Font.ColorIndex = 3 Then
    
15.                 红 = 红 + Val(VBA.Left(Cells(X, Y), 1))
    
16.             ElseIf Cells(X, Y).Characters(1, 3).Font.ColorIndex = -4105 Then
    
17.                 黑 = 黑 + Val(VBA.Left(Cells(X, Y), 1))
    
18.             End If
    
19.         Next
    
20.         Cells(X, "Q") = 红
    
21.         Cells(X, "R") = 黑
    
22.         红 = 0
    
23.         黑 = 0
    
24.     Next
    
25. End Sub

复制代码

跳转到最佳答案楼层

冠军欧洲2010

1. Sub A()
   
2.     Dim RG As Range
   
3.     Dim X, Y
   
4.     Dim 红, 黑
   
5.     For Each RG In Range("B3:P23")
   
6.         If RG.Characters(1, 3).Font.ColorIndex > 0 Then
   
7.             RG.Characters(1, 3).Font.ColorIndex = 3
   
8.         Else
   
9.             RG.Characters(1, 3).Font.ColorIndex = -4105
   
10.         End If
    
11.     Next
    
12.     For X = 3 To 23
    
13.         For Y = 2 To 15
    
14.             If Cells(X, Y).Characters(1, 3).Font.ColorIndex = 3 Then
    
15.                 红 = 红 + Val(VBA.Left(Cells(X, Y), 1))
    
16.             ElseIf Cells(X, Y).Characters(1, 3).Font.ColorIndex = -4105 Then
    
17.                 黑 = 黑 + Val(VBA.Left(Cells(X, Y), 1))
    
18.             End If
    
19.         Next
    
20.         Cells(X, "Q") = 红
    
21.         Cells(X, "R") = 黑
    
22.         红 = 0
    
23.         黑 = 0
    
24.     Next
    
25. End Sub

复制代码