单元格指定底色如何清除内容

ahkin

我做了个单元格，每个月的时候，都要清除这个工作表里底色为RGB（192,192,192）的单元格里的文字或图片，手工清除太麻烦了。可以帮助写个程序吗，清除这个工作表里的所有单元格只要是底色为RGB（192,192,192）的，运行即自动清除。谢谢。

蓝桥玄霜

1. Sub lqxs()
   
2. Dim cel As Range
   
3. For Each cel In ActiveSheet.UsedRange
   
4.     If cel.Interior.Color = RGB(192, 192, 192) Then
   
5.         cel.Interior.ColorIndex = xlNone
   
6.         cel = ""
   
7.     End If
   
8. Next
   
9. End Sub
   

复制代码

zhaogang1960

这个题目可以用Find方法查出符合条件的所有单元格，并删除文本及底色，并检查该单元格有没有图片，如果有则删除：

1. Sub 宏1()
   
2.     Dim c As Range, rng As Range, firstAddress$, m&, d As Object, shp As Shape
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Application.FindFormat
   
5.         .Clear
   
6.         .Interior.Color = RGB(192, 192, 192)
   
7.     End With
   
8.     With ActiveSheet.UsedRange
   
9.         Set c = .Find(What:="", SearchFormat:=True)
   
10.         If Not c Is Nothing Then
    
11.             firstAddress = c.Address
    
12.             Do
    
13.                 m = m + 1
    
14.                 If m > 1 Then Set rng = Union(rng, c) Else Set rng = c
    
15.                 d(c.Address) = ""
    
16.                 Set c = .Find(What:="", After:=c, SearchFormat:=True)
    
17.             Loop While Not c Is Nothing And firstAddress <> c.Address
    
18.         End If
    
19.     End With
    
20.     If m > 0 Then
    
21.         rng.ClearContents'删除符合条件单元格的内容
    
22.         'rng.Interior.ColorIndex = xlNone'这一句删除符合条件单元格的底色，如果要保留，请删除这一句
    
23.         For Each shp In ActiveSheet.Shapes'删除TopLeftCell单元格有特定底色的图片
    
24.             If d.Exists(shp.TopLeftCell.Address) Then shp.Delete
    
25.         Next
    
26.     End If
    
27. End Sub
    

复制代码

ahkin

zhaogang1960 发表于 2013-12-19 17:16
这个题目可以用Find方法查出符合条件的所有单元格，并删除文本及底色，并检查该单元格有没有图片，如果有则 ...

谢谢两位，但底色要保留，只删除文字或图片。以上的会删除底色。

zhaogang1960

ahkin 发表于 2013-12-19 17:22
谢谢两位，但底色要保留。以上的会删除底色。

rng.Interior.ColorIndex = xlNone'删除这一句即可

ahkin

zhaogang1960 发表于 2013-12-19 17:26
rng.Interior.ColorIndex = xlNone'删除这一句即可

还有合并的单元格不能清除文字

zhaogang1960

ahkin 发表于 2013-12-19 17:33
还有合并的单元格不能清除文字

我都看糊涂了，是不让，还是代码清除不了
请上传附件说明吧

ahkin

zhaogang1960 发表于 2013-12-19 17:39
我都看糊涂了，是不让，还是代码清除不了
请上传附件说明吧

是合并的单元格，也要清除文字。但会显示无法清除。

zhaogang1960

ahkin 发表于 2013-12-19 17:44
是合并的单元格，也要清除文字。但会显示无法清除。

猜一猜：

1. Sub 宏1()
   
2.     Dim c As Range, rng As Range, firstAddress$, m&, d As Object, shp As Shape
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Application.FindFormat
   
5.         .Clear
   
6.         .Interior.Color = RGB(192, 192, 192)
   
7.     End With
   
8.     With ActiveSheet.UsedRange
   
9.         Set c = .Find(What:="", SearchFormat:=True)
   
10.         If Not c Is Nothing Then
    
11.             firstAddress = c.Address
    
12.             Do
    
13.                 m = m + 1
    
14.                 If m > 1 Then Set rng = Union(rng, c.MergeArea) Else Set rng = c.MergeArea
    
15.                 d(c.Address) = ""
    
16.                 Set c = .Find(What:="", After:=c, SearchFormat:=True)
    
17.             Loop While Not c Is Nothing And firstAddress <> c.Address
    
18.         End If
    
19.     End With
    
20.     If m > 0 Then
    
21.         rng.ClearContents
    
22.         'rng.Interior.ColorIndex = xlNone
    
23.         For Each shp In ActiveSheet.Shapes
    
24.             If d.Exists(shp.TopLeftCell.Address) Then shp.Delete
    
25.         Next
    
26.     End If
    
27. End Sub
    

复制代码

olywo

zhaogang1960 发表于 2013-12-19 17:48
猜一猜：

如何设置删除所有工作簿的呢？这个是活动表的