Как объединить 2 столбца и сохранить стиль текста с помощью VBA?

Question

У меня есть несколько столбцов, которые мне нужно объединить, в то время как стиль текста для одного столбца остается неизменным, и каждый столбец объединяется в новую строку (возврат каретки).

Col A текст выделен жирным шрифтом, Col B текст обычный, Col C = составной столбец 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

Интерес к приведенному выше коду заключается в том, что он позволяет пользователю указать через поле ввода диапазон ячеек для конкатенации и место для вывода результатов.

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

Если у вас есть более простое решение, я за все, пока оно работает.ps Я запускаю 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