[已解决]如图所示，如何汇总有颜色填充的单元格？？

suge168

如图所示，需要统计某型手机的销售状况，一个月中若有一天有销售记录则该天填充红色，现在需要统计不同销售点这个一个总的销售情况，请问该如何处理？？？请老师指教。

最佳答案

月排行榜 / 总排行榜

grf1973

2016-12-20 15:11

加上总天数的。

跳转到最佳答案楼层

grf1973

是只要显示颜色，还是汇总销量？

suge168

grf1973 发表于 2016-12-20 14:56
是只要显示颜色，还是汇总销量？

都要，在最后面再加一列显示总天数吧

grf1973

1. Sub 统计()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Application.ScreenUpdating = False
   
4.     Dim Filename, wb As Workbook, Sht As Worksheet
   
5.     Filename = Dir(ThisWorkbook.Path & "\*.xlsx")
   
6.     ActiveSheet.UsedRange.Interior.ColorIndex = 0
   
7.     Do While Filename <> ""
   
8.         If Filename <> ThisWorkbook.Name Then
   
9.             fn = ThisWorkbook.Path & "" & Filename
   
10.             Set wb = Workbooks.Open(fn)
    
11.             Set Sht = wb.Worksheets(1)
    
12.             arr = Sht.[a1].CurrentRegion
    
13.             For i = 2 To UBound(arr)
    
14.                 For j = 2 To UBound(arr, 2)
    
15.                     x = arr(i, 1) & arr(1, j)
    
16.                     cl = Sht.Cells(i, j).Interior.ColorIndex
    
17.                     If cl > 0 Then d(x) = cl
    
18.                 Next
    
19.             Next
    
20.             wb.Close False
    
21.         End If
    
22.         Filename = Dir
    
23.     Loop
    
24.    
    
25.     Set Sht = ThisWorkbook.Sheets(1)
    
26.     arr = Sht.[a1].CurrentRegion
    
27.     For i = 2 To UBound(arr)
    
28.         For j = 2 To UBound(arr, 2)
    
29.             x = arr(i, 1) & arr(1, j)
    
30.             If d(x) > 0 Then Sht.Cells(i, j).Interior.ColorIndex = d(x)
    
31.         Next
    
32.     Next
    
33.     Application.ScreenUpdating = True
    
34. End Sub
    

复制代码

grf1973

加上总天数的。

suge168

非常感谢，非常感谢