[已解决]如何选中所有蓝色色域字体的单元格

billyzhang0609

我要选中蓝色字体所在的区域.(其实有好多张表,我要收集蓝色的区域)

我的代码不对,全变蓝色了...

Sub Macro1()
'
    Cells.Select
    With Cells.Font
        .Color = -65536
        .TintAndShade = 0
      
    End With
End Sub

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2014-1-6 11:39

请测试：

1. Sub test()
   
2. Dim rg As Range, rng1 As Range
   
3. For Each rg In Sheets(1).UsedRange
   
4.     If rg.Font.ColorIndex = 5 Then
   
5.        If rng1 Is Nothing Then
   
6.           Set rng1 = rg
   
7.         Else
   
8.            Set rng1 = Union(rng1, rg)
   
9.         End If
   
10.     End If
    
11. Next rg
    
12.    rng1.Select
    
13. End Sub
    

复制代码

跳转到最佳答案楼层

yyyydddd8888

请测试：

1. Sub test()
   
2. Dim rg As Range, rng1 As Range
   
3. For Each rg In Sheets(1).UsedRange
   
4.     If rg.Font.ColorIndex = 5 Then
   
5.        If rng1 Is Nothing Then
   
6.           Set rng1 = rg
   
7.         Else
   
8.            Set rng1 = Union(rng1, rg)
   
9.         End If
   
10.     End If
    
11. Next rg
    
12.    rng1.Select
    
13. End Sub
    

复制代码

metoo77

你的思路反过来了吧

yyyydddd8888

如果要选择多个工作表的字体为蓝色单元格，请用这个：
选中蓝色单元格.rar (14.3 KB, 下载次数: 6)

2014-1-6 11:52 上传

点击文件名下载附件

1. Sub test()
   
2. Dim rg As Range, rng1 As Range, i%
   
3. For i = 1 To Sheets.Count
   
4.     Sheets(i).Activate
   
5.     For Each rg In Sheets(i).UsedRange
   
6.         If rg.Font.ColorIndex = 5 And rg <> "" Then
   
7.            If rng1 Is Nothing Then
   
8.               Set rng1 = rg
   
9.             Else
   
10.                Set rng1 = Union(rng1, rg)
    
11.             End If
    
12.         End If
    
13.     Next rg
    
14.    
    
15.     rng1.Select
    
16.     Set rng1 = Nothing
    
17.     Set rg = Nothing
    
18. Next i
    
19.    
    
20. End Sub
    

复制代码

billyzhang0609

metoo77 发表于 2014-1-6 11:45
你的思路反过来了吧

    Cells.Select
    With Cells.Font
        .Color = -65536
        .TintAndShade = 0
      
    End With
End Sub

    Cells.Select
    With Cells.Font
        .Color = -65536
        .TintAndShade = 0
      
    End With
End Sub

结果是一样的...

billyzhang0609

yyyydddd8888 发表于 2014-1-6 11:39
请测试：

这个稍微有点问题,

选中了一个不是蓝色字体的单元格.

yyyydddd8888

billyzhang0609 发表于 2014-1-6 12:03
这个稍微有点问题,

选中了一个不是蓝色字体的单元格.

1. Sub test()
   
2. Dim rg As Range, rng1 As Range
   
3. For Each rg In Sheets(1).UsedRange
   
4. If rg.Font.ColorIndex = 5 and rg<>"" Then
   
5. If rng1 Is Nothing Then
   
6. Set rng1 = rg
   
7. Else
   
8. Set rng1 = Union(rng1, rg)
   
9. End If
   
10. End If
    
11. Next rg
    
12. rng1.Select
    
13. End Sub

复制代码