[已解决]按条件填充红色

excelpxfans001

按条件填充红色

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-9 13:40

代码如下：

1. Sub xx()
   
2.     Dim arr(), brr(), r&, c&, j&, i&, rng As Range, d1 As Object, d2 As Object
   
3.     Set rng = Sheet1.Range("B8:T12") '自己设定范围
   
4.     arr = Array(0, 1, 4, 5, 8)
   
5.     brr = Array(2, 3, 6, 7, 9)
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     Set d2 = CreateObject("Scripting.Dictionary")
   
8.     rng.Interior.ColorIndex = 0
   
9.     For i = 0 To UBound(arr)
   
10.         d1.Add arr(i), ""
    
11.         d2.Add brr(i), ""
    
12.     Next
    
13.     With rng
    
14.         r = rng.Rows.Count
    
15.         c = rng.Columns.Count
    
16.         For i = 1 To c
    
17.             For j = 1 To r
    
18.                 If d1.Exists(rng(j, i).Value) Then rng(j, i).Interior.Color = 192
    
19.             Next
    
20.         Next
    
21.     End With
    
22. End Sub

复制代码

跳转到最佳答案楼层

fjmxwrs

您这样表述，是找不出规律来的呀，说明得详细点但要简明的表达您的需求，您的AB组是变化的，那么是根据什么来变化呢?这些都要说明白了才好下手。要不然又是不断的改，很浪费时间。一次性说明了，就省去很多的麻烦

excelpxfans001

fjmxwrs 发表于 2016-6-9 10:55
您这样表述，是找不出规律来的呀，说明得详细点但要简明的表达您的需求，您的AB组是变化的，那么是根据什么 ...

AB是固定的哦。不变化的。

excelpxfans001

fjmxwrs 发表于 2016-6-9 10:55
您这样表述，是找不出规律来的呀，说明得详细点但要简明的表达您的需求，您的AB组是变化的，那么是根据什么 ...

你好，都是。AB相当于是固定的。只是会更改AB代表的数字。

老司机带带我

代码如下：

1. Sub xx()
   
2.     Dim arr(), brr(), r&, c&, j&, i&, rng As Range, d1 As Object, d2 As Object
   
3.     Set rng = Sheet1.Range("B8:T12") '自己设定范围
   
4.     arr = Array(0, 1, 4, 5, 8)
   
5.     brr = Array(2, 3, 6, 7, 9)
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     Set d2 = CreateObject("Scripting.Dictionary")
   
8.     rng.Interior.ColorIndex = 0
   
9.     For i = 0 To UBound(arr)
   
10.         d1.Add arr(i), ""
    
11.         d2.Add brr(i), ""
    
12.     Next
    
13.     With rng
    
14.         r = rng.Rows.Count
    
15.         c = rng.Columns.Count
    
16.         For i = 1 To c
    
17.             For j = 1 To r
    
18.                 If d1.Exists(rng(j, i).Value) Then rng(j, i).Interior.Color = 192
    
19.             Next
    
20.         Next
    
21.     End With
    
22. End Sub

复制代码