excel - 如何连接 2 列并使用 VBA 保持文本样式？

Question

我有几列需要连接，而一列的文本样式保持不变，并且每一列都连接在一个新行中(回车)。

Col A 文本以粗体显示，Col B 文本正常，Col C = 连接的 col A 内容 粗体 + 回车 + col B 内容。



将 Concatenate 公式与 CHAR(10) 结合使用是可行的，但显然不会保留文本样式。 VBA 似乎是要走的路，但我完全是新手。

我发现以下代码进行连接，保持样式但对于我的生活，我无法弄清楚如何在字符串中包含带有 vbCrLf 的回车。

Sub MergeFormatCell()
    Dim xSRg As Range
    Dim xDRg As Range
    Dim xRgEachRow As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim I As Integer
    Dim xRgLen As Integer
    Dim xSRgRows As Integer
    Dim xAddress As String
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xSRg = Application.InputBox("Select cell columns to concatenate:", "Concatenate in Excel", xAddress, , , , , 8)
    If xSRg Is Nothing Then Exit Sub
    xSRgRows = xSRg.Rows.Count
    Set xDRg = Application.InputBox("Select cells to output the result:", "Concatenate in Excel", , , , , , 8)
    If xDRg Is Nothing Then Exit Sub
    Set xDRg = xDRg(1)
    For I = 1 To xSRgRows
        xRgLen = 1
        With xDRg.Offset(I - 1)
            .Value = vbNullString
            .ClearFormats
            Set xRgEachRow = xSRg(1).Offset(I - 1).Resize(1, xSRg.Columns.Count)
            For Each xRgEach In xRgEachRow
                .Value = .Value & Trim(xRgEach.Value) & " "
            Next
            For Each xRgEach In xRgEachRow
                xRgVal = xRgEach.Value
                With .Characters(xRgLen, Len(Trim(xRgVal))).Font
                .Name = xRgEach.Font.Name
                .FontStyle = xRgEach.Font.FontStyle
                .Size = xRgEach.Font.Size
                .Strikethrough = xRgEach.Font.Strikethrough
                .Superscript = xRgEach.Font.Superscript
                .Subscript = xRgEach.Font.Subscript
                .OutlineFont = xRgEach.Font.OutlineFont
                .Shadow = xRgEach.Font.Shadow
                .Underline = xRgEach.Font.Underline
                .ColorIndex = xRgEach.Font.ColorIndex
                End With
                xRgLen = xRgLen + Len(Trim(xRgVal)) + 1
            Next
        End With
    Next I
End Sub

上述代码的有趣之处在于，它允许用户通过输入框指定要连接的单元格范围以及输出结果的位置。

任何人都可以帮我修改它，以便每个新列在连接后换成新行？

如果你有一个更简单的解决方案，只要它有效，我就会全力以赴。
p.s.如果这很重要，我正在运行 Excel 2013。

Answer 1

下面的代码不会复制格式，但它会连接两列并且粗体显示值出现在 A 列中。

Option Explicit

Sub test()

    Dim LastRow As Long, Row As Long

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For Row = 1 To LastRow

            With .Range("C" & Row)
                .Value = ThisWorkbook.Worksheets("Sheet1").Range("A" & Row).Value & vbNewLine & ThisWorkbook.Worksheets("Sheet1").Range("B" & Row).Value
                .Characters(1, Len(ThisWorkbook.Worksheets("Sheet1").Range("A" & Row).Value)).Font.FontStyle = "Bold"
            End With

        Next Row

    End With

End Sub

编辑版本:

Option Explicit

Sub test()

    Dim LastRow As Long, Row As Long
    Dim strA As String, strB As String, strC As String, strD As String, strE As String, strF As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For Row = 1 To LastRow

            strA = .Range("A" & Row).Value
            strB = .Range("B" & Row).Value
            strC = .Range("C" & Row).Value
            strD = .Range("D" & Row).Value
            strE = .Range("E" & Row).Value
            strF = .Range("F" & Row).Value

            With .Range("G" & Row)

                .Value = strA & vbNewLine & strB & vbNewLine & strC & vbNewLine & strD & vbNewLine & strE & vbNewLine & strF
                .Characters(1, Len(strA)).Font.FontStyle = "Bold"
                .Characters((Len(strA) + Len(strB) + 5), Len(strC)).Font.FontStyle = "Bold"
                .Characters((Len(strA) + Len(strB) + Len(strC) + Len(strD) + 9), Len(strE)).Font.FontStyle = "Bold"

            End With

        Next Row

    End With

End Sub