Подскажите, пожалуйста, можно ли извлечь цвета частей текста из одной ячейки? Имеется одна ячейка, в которой через тире и пробелы прописаны 3 цифры 3 разных цветов (красный, зелёный и чёрный). Извлечь цифры отдельно получается, а вот цвета этих чисел непонятно как (возможно какой макрос функцией?!) Заранее спасибо!
Андрей VG написал: Вариант. Перекодировку hex значений цветов в названия можете сделать, например, по такой таблице .
Добрый день, Андрей. Возможно ли подправить текст кода, написанный Вами ниже, таким образом, чтобы не выдавало ошибку, если весь текст в ячейке написан одним цветом?
Код
Option Explicit
Public Function Test(ByVal foo As Range) As Variant
Dim pReg As Object, sXml As String, pItems As Object
Dim vOut() As Variant, i As Long
If foo.Count = 1 Then
Set pReg = CreateObject("VBScript.RegExp")
pReg.Global = True: pReg.IgnoreCase = True
pReg.Pattern = "<Font[^>""]*?(?:html:Color=""(#[A-F\d]+)"")?>(.+?)</FONT>"
sXml = foo.Value(xlRangeValueXMLSpreadsheet)
Set pItems = pReg.Execute(sXml)
ReDim vOut(0 To pItems.Count - 1, 1 To 2)
For i = 0 To pItems.Count - 1
vOut(i, 1) = pItems(i).SubMatches(1)
vOut(i, 2) = pItems(i).SubMatches(0)
If IsEmpty(vOut(i, 2)) Then vOut(i, 2) = "#000000"
Next
Test = vOut
End If
End Function
Можно конечно, прописать мини-функцию. С добавлением IFERROR(Test(A2);OneColor(A2)). Но это неудобно для работы с большим кол-вом данных.
Код
Public Function OneColor(Cell As Range)
OneColor = Cell.Font.Color
End Function