TL;DR:是否可以根据颜色删除单元格中的特定文本,而不会丢失其他单元格内容的剩余格式。到目前为止,任何可行的解决方案都可以删除特定颜色的文本,但会删除剩余的格式。
我最近接手了一个大型电子表格,其中有一个部分单元格有换行符,每个框中有多个文本行。之前管理电子表格的人根据每个项目的状态为每行着色。下面是一个示例(方括号表示每行格式化的颜色,还请注意,每个项目后都应该有换行符)。
31029 - Control [RED - bolded]
67934 - Control [BLUE]
41235 - Control [BLACK]
64304 - Action [GREEN - bolded]
69056 - Control [BLACK]
有几列(和多行)的数据与上面类似(即,一列用于分配给每个操作的团队成员,一列用于描述,一列用于状态),但每列都遵循相同的颜色编码格式。
我需要做的是删除blue (RGB(0,0,139))
每个单元格中的所有项目但保留剩余的内容和格式。
这可能吗?
在提交这个问题之前我尝试了很多解决方案,例如超级用户上的这个将信息复制到 word 中,然后再复制到 excel 中。对我来说,这种方法很管用,但当我删除 excel 中的段落标记时,所有剩余的格式都被删除了(尽管我可以使用 Word 删除蓝色文本)。
我也尝试了 Stackoverflow 上的几种 VBA 解决方案,但似乎无法使其工作。我还尝试使用 excel 中的 SUBSTITUTE 函数删除 Pilcrow,但它仍然会删除剩余的格式。
我很幸运能用上 MrExcel 回复中详细介绍的“字符删除方法”https://www.mrexcel.com/forum/excel-questions/677646-delete-text-within-cell-specific-color-retain-formatting-remaining-text.html但是,出于某种原因,在我将代码从 colorindex 更改为颜色 RGB 格式并输入范围后,它删除了一些蓝色文本,但不是全部。当单元格包含许多字符时(可能比那些 vba 变量可以处理的字符还多),它似乎会留下蓝色文本?
答案1
这假设
- 单元格中的每一行都具有相同
color
和bold
ness特征 - 要处理的数据在 A 列
算法:
- 获取要测试的范围
vbLf
用作为分隔符来拆分单元格内容- 创建一个包含文本字符串、粗体和颜色的类
- 将类的每个实例保存到集合中,除非它具有要删除的颜色。
- 重新创建没有相关行的单元格文本,并逐行格式化单元格数据作为原始格式
类模块 重命名:cLineData
Public pText As String
Public pBold As Boolean
Public pColor As Long
Public pLength As Long
常规模块
Option Explicit
Sub DeleteColoredLine()
Dim cLD As cLineData, Coll As Collection
Dim wsSrc As Worksheet
Dim R As Range, C As Range, V As Variant, W As Variant
Dim lineNum As Long, charPos As Long, I As Long
Set wsSrc = Worksheets("sheet4")
With wsSrc
Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each C In R
Set Coll = New Collection
V = Split(C.Text, vbLf)
For lineNum = 0 To UBound(V)
Set cLD = New cLineData
charPos = charPos + Len(V(lineNum)) + 1 'include newline character
cLD.pText = V(lineNum)
cLD.pLength = Len(cLD.pText)
With C.Characters(charPos - 1, 1).Font 'last printed character in line
cLD.pBold = .Bold
cLD.pColor = .Color
End With
'Check for color to be removed
If Not cLD.pColor = RGB(0, 112, 192) Then _
Coll.Add cLD
Next lineNum
'Create the new string
I = 0
ReDim V(0 To Coll.Count - 1)
For Each cLD In Coll
V(I) = cLD.pText
I = I + 1
Next cLD
C.Offset(0, 1).Value = Join(V, vbLf)
'Format the lines
charPos = 1
With C.Offset(0, 1)
For Each cLD In Coll
With .Characters(charPos, cLD.pLength).Font
.Bold = cLD.pBold
.Color = cLD.pColor
End With
charPos = charPos + Len(cLD.pText) + 1 '+1 to include newline character
Next cLD
End With
Next C
End Sub
注意,
- 可以将其他格式特征添加到课堂测试中,以进行测试和/或重现
- 我的蓝色(RGB 代码)与你的蓝色
- 此宏将结果放在相邻列中。您也可以选择覆盖原始列或隐藏它。
在下面的屏幕截图中,A 列是原始的,B 列是运行上述宏的结果。