首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >如何仅将单元格中的红色文本复制到另一个单元格中?

如何仅将单元格中的红色文本复制到另一个单元格中?
EN

Stack Overflow用户
提问于 2022-08-30 14:55:54
回答 1查看 78关注 0票数 0

我在Excel中有包含不同颜色文本的单元格。我希望能够将特定颜色的文本提取到另一个单元格中。

我如何修改我的UDF来解释这一点?

代码语言:javascript
复制
Function RedText(Rng As Range) As String
  Dim X As Long, S As String
  S = Rng.Text
  For X = 1 To Len(Rng.Text)
    If Rng.Characters(X, 1).Font.Color <> vbRed Then
      If Mid(S, X, 1) <> vbLf Then Mid(S, X, 1) = " "
    End If
  Next
  RedText = Replace(Replace(Application.Trim(S), " " & vbLf, vbLf), vbLf & " ", vbLf)
End Function

谢谢

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2022-08-30 17:02:06

例如:

代码语言:javascript
复制
Function TextByColor(Rng As Range, hex As String) As String
  Dim X As Long, S As String, clr As Long
  S = Rng.Text
  clr = HexToRGB(hex)
  For X = 1 To Len(Rng.Text)
    If Rng.Characters(X, 1).Font.Color <> clr Then
      If Mid(S, X, 1) <> vbLf Then Mid(S, X, 1) = " "
    End If
  Next
  RedText = Replace(Replace(Application.Trim(S), " " & vbLf, vbLf), vbLf & " ", vbLf)
End Function

Function HexToRGB(hex As String) As Long
    Dim r, g, b
    r = Application.Hex2Dec(Left(hex, 2))
    g = Application.Hex2Dec(Mid(hex, 3, 2))
    b = Application.Hex2Dec(Right(hex, 2))
    HexToRGB = RGB(r, g, b)
End Function

'Added: >10x faster alternative to using `Application.Hex2Dec`
Function HexToRGB2(hex As String) As Long
    Dim r As Long, g As Long, b As Long
    b = CLng("&H" & Right(hex, 2))
    g = CLng("&H" & Mid(hex, 3, 2))
    r = CLng("&H" & Left(hex, 2))
    HexToRGB2 = RGB(r, g, b)
End Function

用法:=textbycolor(A3,"0000FF")

正如注释中所指出的,这里是为什么不能对完整的十六进制值使用HEX2DEC (R和G组件被切换):

票数 3
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/73544519

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档