Excel VBAmacros连接列并保留颜色/样式格式

我正在寻找使用一个新的列来结合其他两列与值之间的换行符。 第二列使用斜体字和彩色RGB(226,239,218)文本RGB(226,239,218)

这个macros需要遍历数据集的每一行来执行这个操作。 如果我在单元格中使用公式,它看起来像=CONCATENATE(A1 & CHAR(10) & B1) ,但是当然这不会保留格式,所以需要在VBA中完成。

举例来说,单元格A1包含“Bobby”,单元格B1包含“Football Player”,因此单元格C1应该如下所示:

鲍比
足球运动员

(“足球运动员”的文字应该是彩色的)

我的VBA知识不是很好,我很乐意帮助! 谢谢!

好的,在这里,你走了。 这应该让你去:

 Dim myRange As Range Set myRange = Range("A1:A2") 'Set the range of the first column cells For Each c In myRange.Cells If c.Value <> "" Then 'Concatenate in 3rd column If c.Offset(0, 1).Value = "" Then c.Offset(0, 2).Value = c.Value Else c.Offset(0, 2).Value = c.Value & Chr(10) & c.Offset(0, 1).Value 'Apply formatting with preserving colors c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Color = c.Offset(0, 1).Font.Color c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Italic = c.Offset(0, 1).Font.Italic c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Bold = c.Offset(0, 1).Font.Bold End If End If Next c 
 Sub test() Dim cell As Range Application.ScreenUpdating = False For Each cell In Range("A1", Range("A" & Rows.Count).End(xlUp)) Call concatenate_cells_formats(cell.Offset(, 2), cell.Resize(, 2)) 'Destination column C, Source A:B Next cell Application.ScreenUpdating = True End Sub Sub concatenate_cells_formats(cell As Range, source As Range) Dim c As Range Dim i As Integer i = 1 With cell .Value = vbNullString .ClearFormats For Each c In source If Len(c.Value) Then .Value = .Value & " " & Trim(c) Next c .Value = Trim(Mid(.Value, 2)) For Each c In source With .Characters(Start:=i, Length:=Len(Trim(c))).Font .Name = c.Font.Name .FontStyle = c.Font.FontStyle .Size = c.Font.Size .Strikethrough = c.Font.Strikethrough .Superscript = c.Font.Superscript .Subscript = c.Font.Subscript .OutlineFont = c.Font.OutlineFont .Shadow = c.Font.Shadow .Underline = c.Font.Underline .ColorIndex = c.Font.ColorIndex End With .Characters(Start:=i + Len(c) + 1, Length:=1).Font.Size = 1 i = i + Len(Trim(c)) + 1 Next c End With End Sub