Перевернуть текст внутри ячейки с сохранением цвета шрифта

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Перевернуть текст внутри ячейки с сохранением цвета шрифта (Макросы/Sub)

t330

Дата: Четверг, 28.07.2022, 23:49 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 147

Репутация: 0 ±

Замечаний: 20% ±

Excel 2016

Всем привет.

Бьюсь второй день над задачкой , как перевернуть текст в ячейке так, чтобы фразы между запятыми исходной ячейки шли в обратном порядке в новой ячейке.
НО при этом, чтобы сохранялись ЦВЕТА шрифтов внутри фраз (см картинку).

Я смог написать только упрощенный макрос , где цвет шрифтов у перевернутых фраз окрашивается в цвет самой первой буквы этой фразы...

Ума не приложу как сделать такой результать , который требуется на картинке. То есть, как вытянуть цвет каждой буквы в отдельности я понимаю, но как потом раскрасить перевернутые фразы - завис...

Если у кого-то будут идеи, буду благодарен за наводку.
Спасибо.

К сообщению приложен файл: test.xlsm (21.3 Kb)

Сообщение отредактировал t330 - Четверг, 28.07.2022, 23:50

Ответить

Pelena

Дата: Пятница, 29.07.2022, 09:29 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19403

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Вариант в файле

К сообщению приложен файл: 1101489.xlsm (23.9 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

t330

Дата: Пятница, 29.07.2022, 11:28 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 147

Репутация: 0 ±

Замечаний: 20% ±

Excel 2016

Огромное спасибо!
С уважением!

Сообщение отредактировал Serge_007 - Пятница, 29.07.2022, 11:31

Ответить

Kuzmich

Дата: Пятница, 29.07.2022, 13:34 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 713

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

Цитата

как потом раскрасить перевернутые фразы

Если запятых, разделяющих текст всегда 3, то можно попробовать так
[vba]

Код

Sub iColorReverse()
Dim arr
Dim i As Long
Dim mo As Object
Dim l_1 As Integer, l_2 As Integer, l_3 As Integer, l As Integer
Dim n As Long
  arr = Application.Trim(Split(Range("A1"), ","))
    Range("B1").ClearContents
    Range("B1").Font.ColorIndex = 1
  For i = UBound(arr) To 1 Step -1
    Range("B1") = Range("B1") & arr(i) & ", "
  Next
  Range("B1") = Left(Range("B1"), Len(Range("B1")) - 2)
   With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = ","
     Set mo = .Execute(Range("A1"))
       l_1 = mo(0).firstIndex + 1   'позиция первой запятой
       l_2 = mo(1).firstIndex + 1   'второй
       l_3 = mo(2).firstIndex + 1   'третьей
       l = Len(Range("A1"))
   End With
   n = 1
   For i = l_3 + 2 To l
     Range("B1").Characters(n, 1).Font.ColorIndex = Range("A1").Characters(i, 1).Font.ColorIndex
     n = n + 1
   Next
     n = n + 2
   For i = l_2 + 2 To l_3 - 1
     Range("B1").Characters(n, 1).Font.ColorIndex = Range("A1").Characters(i, 1).Font.ColorIndex
     n = n + 1
   Next
     n = n + 2
   For i = l_1 + 2 To l_2 - 1
     Range("B1").Characters(n, 1).Font.ColorIndex = Range("A1").Characters(i, 1).Font.ColorIndex
     n = n + 1
   Next
     n = n + 2
   For i = 1 To l_1 - 1
     Range("B1").Characters(n, 1).Font.ColorIndex = Range("A1").Characters(i, 1).Font.ColorIndex
     n = n + 1
   Next
End Sub

[/vba]