Нужен макрос для поддержания цвета шрифта

#excel #vba

Вопрос:

У меня есть макрос, который предлагает пользователю выбрать ячейки — они могут быть несмежными — и вставить их в выбранную пользователем ячейку. Я нашел макрос где-то в Интернете, и это здорово.

Я хочу добавить цвет шрифта. Ячейки, из которых копируются, имеют определенные цвета, и мне нужно иметь возможность сохранять цвет в вставленной ячейке. Любая помощь будет очень признательна! Спасибо

 Sub G()  Dim strFinal$ Dim cell As Range Dim rngSource As Range Dim rngArea As Range Dim rngTarget As Range  Set rngSource = Application.InputBox("Select cells to merge", Type:=8) Set rngTarget = Application.InputBox("Select destination cell", Type:=8) For Each rngArea In rngSource  For Each cell In rngArea  strFinal = strFinal amp; cell.Value amp; " "  Next Next strFinal = Left$(strFinal, Len(strFinal) - 1) rngTarget.Value = strFinal  End Sub

Редактировать: Я включил изображение, показывающее, что мне нужно — я только что сделал это вручную, чтобы дать лучшее описание, но я ищу макрос, чтобы сделать это с любыми ячейками, которые выберет пользователь. Спасибо

1. Только цвет шрифта или все форматирование ячейки?

2. Меняется ли цвет текста внутри ячейки или от ячейки к ячейке, или и то, и другое?

3. Если вы это сделаете Range1.Copy Destination:=Range2 , он скопирует все значения и форматирование. Если вы не хотите, чтобы все форматирование выполнялось, вам придется скопировать данные шрифта отдельно для каждой ячейки. Нет простого способа скопировать и вставить шрифт диапазона, за исключением других форматов.

4. Вы имеете в виду, что цвет каждой ячейки должен быть сохранен или все ячейки имеют один и тот же цвет в источнике?

Ответ №1:

Это позволит скопировать текст из нескольких ячеек в одну ячейку, сохранив цвет и размер шрифта в каждой ячейке.

В этом примере я использовал только 2 несмежные ячейки, но его можно легко адаптировать для работы с несмежными областями, добавив сквозной цикл Areas .

Вы также можете добавить дополнительный код для копирования поверх форматирования других типов, например, полужирного, курсивного и т.д., Но я уверен, что это должно быть жестко закодировано.

 Option Explicit  Sub CopyTextAndFont() Dim cl As Range Dim rngSrc As Range Dim rngDst As Range Dim chSrc As Characters Dim chDst As Characters Dim idxChr As Long Dim cnt As Long   Set rngSrc = Range("B2, B7")   Set rngDst = Range("E5")    rngDst.Value = ""    For Each cl In rngSrc.Cells  rngDst.Characters.Insert rngDst.Value amp; cl.Value  Next cl    For Each cl In rngSrc.Cells  For idxChr = 1 To cl.Characters.Count  cnt = cnt   1  Set chSrc = cl.Characters(idxChr, 1)  Set chDst = rngDst.Characters(cnt, 1)  chDst.Font.ColorIndex = chSrc.Font.ColorIndex  chDst.Font.Size = chSrc.Font.Size  Next idxChr  Next cl   End Sub