Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перевернуть текст внутри ячейки с сохранением цвета шрифта - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перевернуть текст внутри ячейки с сохранением цвета шрифта (Макросы/Sub)
Перевернуть текст внутри ячейки с сохранением цвета шрифта
t330 Дата: Четверг, 28.07.2022, 23:49 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Всем привет.

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

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

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

Если у кого-то будут идеи, буду благодарен за наводку.
Спасибо.
К сообщению приложен файл: test.xlsm (21.3 Kb)


Сообщение отредактировал t330 - Четверг, 28.07.2022, 23:50
 
Ответить
СообщениеВсем привет.

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

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

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

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

Автор - t330
Дата добавления - 28.07.2022 в 23:49
Pelena Дата: Пятница, 29.07.2022, 09:29 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19165
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте.
Вариант в файле
К сообщению приложен файл: 1101489.xlsm (23.9 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Вариант в файле

Автор - Pelena
Дата добавления - 29.07.2022 в 09:29
t330 Дата: Пятница, 29.07.2022, 11:28 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

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


Сообщение отредактировал Serge_007 - Пятница, 29.07.2022, 11:31
 
Ответить
СообщениеОгромное спасибо!
С уважением!

Автор - t330
Дата добавления - 29.07.2022 в 11:28
Kuzmich Дата: Пятница, 29.07.2022, 13:34 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 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]
 
Ответить
Сообщение
Цитата
как потом раскрасить перевернутые фразы

Если запятых, разделяющих текст всегда 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]

Автор - Kuzmich
Дата добавления - 29.07.2022 в 13:34
t330 Дата: Пятница, 29.07.2022, 14:26 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Вариант в файле


Почему-то код не работает в 1й и 3й строчках:)
Не могли бы вы посмотреть еще раз?
К сообщению приложен файл: test2.xlsm (27.5 Kb)
 
Ответить
Сообщение
Вариант в файле


Почему-то код не работает в 1й и 3й строчках:)
Не могли бы вы посмотреть еще раз?

Автор - t330
Дата добавления - 29.07.2022 в 14:26
t330 Дата: Пятница, 29.07.2022, 14:28 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Если запятых, разделяющих текст всегда 3


спасибо. количество фраз разделенных запятыми в разных строках разное..
то есть не всегда 3 запятые.
 
Ответить
Сообщение
Если запятых, разделяющих текст всегда 3


спасибо. количество фраз разделенных запятыми в разных строках разное..
то есть не всегда 3 запятые.

Автор - t330
Дата добавления - 29.07.2022 в 14:28
Pelena Дата: Пятница, 29.07.2022, 15:06 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 19165
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Количество запятых не влияет на результат.
Проверьте так
К сообщению приложен файл: 3973540.xlsm (25.2 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеКоличество запятых не влияет на результат.
Проверьте так

Автор - Pelena
Дата добавления - 29.07.2022 в 15:06
t330 Дата: Пятница, 29.07.2022, 16:16 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Проверьте так


Работает , спасибо!
 
Ответить
Сообщение
Проверьте так


Работает , спасибо!

Автор - t330
Дата добавления - 29.07.2022 в 16:16
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перевернуть текст внутри ячейки с сохранением цвета шрифта (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!