excel - 通过保持第一个单元格的格式连接两个相邻单元格的宏

Question

我正在使用下面的代码将两个相邻的单元格与换行符合并，但我想保留第一个具有下划线的单元格的源格式。如何在下面的代码中嵌入代码行以保持第一个单元格的下划线格式。请看下图，我需要这样的东西。



但是当前的宏只是合并而不保持下划线格式。



我还需要将单个单元格中的结果与源格式合并。

    Sub linebreak()

Dim myRange As Range

Set myRange = Range("K2:K51")  '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


End Sub

Answer 1

请试试这个:

Sub linebreak()
Dim myRange As Range, c As Range
Set myRange = Range("K2:K6")  '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(1, Len(CStr(c.Value))).Font.Color = c.Font.Color
            c.Offset(0, 2).Characters(1, Len(CStr(c.Value))).Font.Italic = c.Font.Italic
            c.Offset(0, 2).Characters(1, Len(CStr(c.Value))).Font.Bold = c.Font.Bold
            c.Offset(0, 2).Characters(1, Len(CStr(c.Value))).Font.Underline = c.Font.Underline
        End If
    End If
 Next c
End Sub

您必须从 1 开始格式化字符，使用 Len(c.Value)对于格式化长度，应用 c 的格式并使用 Underline为了做你想做的...

在这里，您最后一个请求的解决方案:

Sub AllConc()
 Dim myRange As Range, c As Range, strC As String
 Set myRange = Range("K2:K5")
 For Each c In myRange
    If c.Value <> Empty Then
        strC = strC & c.Value & vbCrLf
    End If
 Next
 strC = left(strC, Len(strC) - 1)
 Range("K6").Value = strC
End Sub

连接的字符串在“K6”处返回。