Question

我希望使用新列来组合其他2列，并在值之间使用换行符。第二列使用斜体并在RGB(226,239,218)中着色的文本。

此宏需要遍历数据集的每一行才能执行此操作。如果我在单元格中使用公式，它看起来像=CONCATENATE(A1 & CHAR(10) & B1)，但当然这不保留格式，因此需要在VBA中完成。

为了说明，单元格A1包含＆＃34; Bobby＆＃34;并且单元格B1包含＆＃34;足球运动员＆＃34;，因此单元格C1应该如下：

巴比
的 足球运动员

（＆＃39;足球运动员＆＃39;文字应该是彩色的）

我的VBA知识不是很好，我一定会感谢你的帮助！谢谢！

Answer 1

好的，你走了。这应该让你去：

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

Answer 2

＆＃13;

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

＆＃13;

Excel VBA宏以连接列并保留颜色/样式格式

2 个答案: