使用Excel表格的所有单元格更改文本的颜色

有没有办法改变Excel工作表中的所有单元格中的文本的颜色？ 就像查找文本一样，只是为Excel工作表的单元格更改search文本的前景色。

Answer 1

更改Excel表格的所有单元格的颜色：

举个例子：

1. select整个工作表或一系列单元格。
2. 在Home选项卡上selectConditional Formatting
3. 点击New Rule...
4. 单击Use a formula to determine which cells to format
5. 在Format cells where this value is trueinput公式：=（LEN（$ A $ 1）> 0）
6. 单击Format并转到Fill选项卡
7. select一种填充颜色。 点击确定，确定。

现在，如果单元格A1中有任何值，则步骤1中select的整个范围将改变颜色。 您可以根据需要指定不同的单元格区域，条件或格式。 （例如，文字颜色而不是填充颜色）

---

编辑＃1：

Re： 查找和replace可以改变一部分单元格的颜色

查找和replace可以search或replace单元格格式，但replace格式会影响整个单元格。

结果:(全细胞改变）

---

编辑＃2a：

你说“没有VBA”，但为了分享可能的替代解决scheme，这里是如何用VBA完成的。 此方法循环遍历ActiveSheet.UsedRange所有单元格：

 Sub SearchReplace_Color_PartialCell() Const textToChange = "cat" Const newColor = vbRed Dim c As Range 'loop throgh all cells that have data For Each c In ActiveSheet.UsedRange.Cells If InStr(c.Value, textToChange) > 0 Then 'if text exists in cell ' then change the color of that text c.Characters(InStr(c.Value, textToChange), Len(textToChange)).Font.Color = newColor End If Next c End Sub 

当运行10,000个单元格，每个单元格的长度都不相同时，所有的单词都是“cat”，这个方法运行在2.6797秒 。

---

编辑＃2b：

另一个VBA解决scheme，使用.Find和.FindNext循环通过数据单元：

 Sub FindReplace_Color_PartialCell() Const textToChange = "cat" Const newColor = vbRed Dim c As Range, firstAddress As String With ActiveSheet.Cells Set c = .Find(textToChange, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.Characters(InStr(c.Value, textToChange), Len(textToChange)).Font.Color = vbGreen Set c = .FindNext(c) If c Is Nothing Then GoTo DoneFinding End If Loop While c.Address <> firstAddress End If DoneFinding: End With End Sub 

当运行在每个具有不同长度string的10,000个单元上时，全部在中间具有单词“猫”，该方法在8.7021秒内运行 。

---

编辑＃2c：

修改为继续search单元格，直到找不到更多匹配（而不是在一次replace后移动到下一个单元格）：

 Sub SearchReplace_Color_PartialCell() 'modified to catch multiple occurences of search term within the single cell Const textToChange = "cat" Const newColor = vbGreen Dim c As Range 'the cell we're looking at Dim pos As Integer 'current position#, where we're looking in the cell (0 = Not Found) Dim matches As Integer 'count number of replacements For Each c In ActiveSheet.UsedRange.Cells 'loop throgh all cells that have data pos = 1 Do While InStr(pos, c.Value, textToChange) > 0 'loop until no match in cell matches = matches + 1 pos = InStr(pos, c.Value, textToChange) c.Characters(InStr(pos, c.Value, textToChange), Len(textToChange)).Font.Color = _ newColor ' change the color of the text in that position pos = pos + 1 'check again, starting 1 letter to the right Loop Next c MsgBox "Replaced " & matches & " occurences of """ & textToChange & """" End Sub