Извлечение цвета шрифта в формулах Excel - PullRequest
Новая
       18

Извлечение цвета шрифта в формулах Excel

0 голосов
/ 23 мая 2018

Я разрабатываю приложение для обучения покеру и просто добавляю несколько последних штрихов -

Screenshot

Это может быть больше проблемой VBA, но у меня есть столбец для каждой картызначение (все карты от 2 до А в каждой масти), алмазы и сердца окрашены в красный цвет).

В идеале я хотел бы, чтобы карты, показанные в столбцах «Рука» и «Флоп», отображались вкрасный - то есть любая пара символов, где последний символ в последовательности равен ♥ или ♦

. Для справки формула для столбца «Рука»: 

=F2&"  "&F3

и длястолбец 'Flop': 

=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

Результат снизу ответа

1 Ответ

0 голосов
/ 23 мая 2018

Попробуйте это: 

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
...