在Excel公式中提取字体颜色

Question

我正在设计一个扑克培训应用程序，只是添加一些收尾工作 -

这可能更像是一个 VBA 问题，但是，我为每张卡片的价值（每套从 2 到 A 的所有卡片）设置了一个列，其中菱形和心形为红色）。

理想情况下，我希望手牌和翻牌列中显示的牌 - 显示为红色 - 即序列中最后一个字符是♥或♦的任何一对字符

作为参考，“手”列的公式是：

=F2&"  "&F3

对于“翻牌”栏：

=F4&"  "&F5&"  "&F6

我尝试了条件格式，但它突出显示了整个单元格，而不仅仅是特定字符 - 我尝试了以下 VBA 代码，每次尝试运行它时都会冻结我的 Excel：

Function GetColorText(pRange As Range) As String
'Updateby20141105
Dim xOut As String
Dim xValue As String
Dim i As Long
xValue = pRange.Text

For i = 1 To VBA.Len(xValue)

    If pRange.Characters(i, 1).Font.Color = vbRed Then
        xOut = xOut & VBA.Mid(xValue, i, 1)
    End If

Next

GetColorText = xOut
   End Function

Result from below answer

Answer 1

试试这个：

Public Enum Suits
    spade = 9824
    heart = 9829
    diamond = 9830
    club = 9827
End Enum

Sub ColorSuits(ByRef c As Range)
    Dim s() As String
    Dim i As Integer
    Dim x As Integer, y As Integer

    s = Split(c.Value, "  ")
    For i = LBound(s) To UBound(s)
          x = InStr(c.Value, s(i))
          y = Len(s(i))
          c.Characters(x, y).Font.Color = SuitColor(s(i))
    Next i
End Sub

Function SuitColor(ByVal s As String)
    Select Case Right(s, 1)
        Case ChrW(heart), ChrW(diamond)
            SuitColor = vbRed
        Case Else
            SuitColor = vbBlack
    End Select
End Function


Sub Test()
    Dim c As Range
    For Each c In Selection
        ColorSuits c
    Next c
End Sub