[已解决]求助：根据格式要求填充单元格颜色

jinyueli85

求助各位大神！！！左边四列是需要手动填写的，右边是2017年1月1日至12月31日，这部分是需要填充颜色的，填充颜色的规则，根据左边四列填写的内容而定。如果活动部门是1，填充颜色是黄色，如果部门是2，填充颜色是蓝色，以此类推；填充单元格的起始时间对应的活动上的起始时间，填充单元格的结束时间是活动上的结束时间（从第五列开始编著的时间2017.01.01-2017.12.31），请各位大神指教如何实现，谢谢

最佳答案

月排行榜 / 总排行榜

grf1973

2017-1-20 11:28

1. Sub 编色()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     [e2].Resize(UBound(arr), UBound(arr, 2)).Interior.ColorIndex = 0
   
5.     For j = 5 To UBound(arr, 2)
   
6.         rq = arr(1, j)
   
7.         d(rq) = j   '日期对应的列
   
8.     Next
   
9.     For i = 2 To UBound(arr)
   
10.         rq = arr(i, 3): ts = arr(i, 4) - arr(i, 3) + 1 '起始日期，天数
    
11.         Cells(i, d(rq)).Resize(1, ts).Interior.Color = Cells(i, 2).Interior.Color
    
12.     Next
    
13. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 编色()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     [e2].Resize(UBound(arr), UBound(arr, 2)).Interior.ColorIndex = 0
   
5.     For j = 5 To UBound(arr, 2)
   
6.         rq = arr(1, j)
   
7.         d(rq) = j   '日期对应的列
   
8.     Next
   
9.     For i = 2 To UBound(arr)
   
10.         rq = arr(i, 3): ts = arr(i, 4) - arr(i, 3) + 1 '起始日期，天数
    
11.         Cells(i, d(rq)).Resize(1, ts).Interior.Color = Cells(i, 2).Interior.Color
    
12.     Next
    
13. End Sub
    

复制代码

jinyueli85

grf1973 发表于 2017-1-20 11:28

谢谢大神~~~