Да, нет там ограничения - просто ленился. Application.Trim даёт проблему Он же под ограниченное число символов в ячейке рассчитан. Переделал. 1,3 секунды на 10000 ячеек на ноуте 7-летней давности.
Код
Public Sub AddItalicForRed()
Dim t As Single
Dim sXml As String
Dim pReg As Object
t = Timer
Set pReg = CreateObject("VBScript.RegExp")
pReg.Global = True: pReg.IgnoreCase = True
sXml = Selection.Value(xlRangeValueXMLSpreadsheet)
pReg.Pattern = "\r\n|\r|\n"
sXml = pReg.Replace(sXml, vbCr)
pReg.Pattern = "\r+"
sXml = pReg.Replace(sXml, " ")
pReg.Pattern = "(<Font +html:Color=""#FF0000"">[^<>]+</Font>)(?!</I>)"
sXml = pReg.Replace(sXml, "<I>$1</I>")
Selection.Value(xlRangeValueXMLSpreadsheet) = sXml
MsgBox Timer - t
End Sub
P. S. ТС какой забавный попался - пришёл на форум как магазин
Андрей VG, Андрей, еще пара таких примеров и пойду вкуривать регулярки :-) , а пока не разобрался
Код
Public Sub AddItalicForRed2()
Dim t As Single
Dim sXml As String
Dim pReg As Object
t = Timer
sXml = Selection.Value(xlRangeValueXMLSpreadsheet)
a = Split(sXml, vbCrLf)
For i = 0 To UBound(a)
a(i) = Application.Trim(a(i))
Next
sXml = Join(a, " ")
'sXml = Replace(sXml, vbCrLf, "")
a = Split(sXml, "<Font html:Color=""#FF0000"">")
If UBound(a) > 0 Then
For i = 1 To UBound(a)
B = Split(a(i), "</Font>")
B(0) = "<I>" & B(0) & "</I>"
a(i) = Join(B, "</Font>")
Next
sXml = Join(a, "<Font html:Color=""#FF0000"">")
End If
Selection.Value(xlRangeValueXMLSpreadsheet) = sXml
MsgBox Timer - t
End Sub
Андрей VG написал: да, но красный текст уже может быть помечен курсивом
да, но дадим приложению решить какой из курсивов первичен :-) . Я тоже думал что приведет к вложенности, но по факту остается всегда один и более того, он всегда встает перед/после тега цвета.
ну так это посимвольное преобразование, что вариант от Александра докрученный мной до форматирования группы символов, что вариант Андрея с регулярками, что мой по его стопам но через split , нормально форматирует.