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

【问题标题】：Macro to concatenate the two adjacent cells by keeping the format of the first cell通过保持第一个单元格的格式连接两个相邻单元格的宏
【发布时间】：2020-08-07 01:30:28
【问题描述】：

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

但当前宏只是合并，不保留下划线格式。

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

    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

【问题讨论】：

您不能连接文本并保持其格式。你需要通过它的字符。 Here 就是一个例子。
@JvdV：他不能在由公式产生的文本中做到这一点。但他可以做一个普通的串联......
那会很容易出错@FaneDuru（“错误”在不需要的结果中）
@JvdV：一点也不，如果你知道你在做什么，我想。请看我的回答。
@FaneDuru。如果c.Offset(0,1) 有下划线/粗体/斜体或任何其他格式（甚至每个字符）怎么办。我总是选择迭代字符来保存。除非在 OP 的情况下，左列是 only 值，可以格式化为 whole。即使你知道自己在做什么，这也是一个危险的假设。

标签： excel vba excel-formula

【解决方案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”处返回。

【讨论】：

谢谢，但这段代码只能在 Column 中的部分字符串下划线。就像上图一样，字符串“Pink”应该加下划线，但是当我运行你的代码时，它只在字符串中加下划线，例如别针。请你帮忙，感觉我快到了。是否与您上面解释的 lelen 函数有关。
@Revan Erraboina：刷新页面并使用更新后的代码。最初我使用了你的想法，没有将字符串更改为格式化长度（c长度，而不是偏移长度）......
@Revan Erraboina：如果“真棒”，你为什么不勾选代码的左侧，将其标记为答案......？ :)
..我的错，完成了。
将输出粘贴到另一个 Web 应用程序时，格式丢失。有没有一种方法可以让我们喜欢将输出合并到单个单元格中而不会丢失格式。在上面的代码中，范围是 ("K2:K5") ，现在所有基于此范围的输出单元格都应该合并为单个单元格而不改变格式。请帮忙。

【解决方案2】：

您使用 Offset 引用了错误的列。您的主要参考是：

Set myRange = Range("K2:K51")  'Set the range of the first column cells

根据你自己的代码，这是第一列单元格。

稍后您会执行c.Offset(0, 1).Font.Color，因此您引用的是未应用格式的列 L。它应该是c.Font.Color

试试：

Sub linebreak()

Dim myRange As Range
Dim c 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.Font.Color
            c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Italic = c.Font.Italic
            c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.Bold = c.Font.Bold
        End If
    End If
Next c


End Sub

【讨论】：

我不太明白，请您解释一下，我需要更改代码的哪一部分才能得到结果。