如何使用 VBA 合并 excel 中的两个单元格（均包含内容）以保持格式不变？答案

【问题标题】：How to merge two cells in excel(both with contents) keeping the formatting intact using VBA?如何使用 VBA 合并 excel 中的两个单元格（均包含内容）以保持格式不变？
【发布时间】：2014-08-12 02:22:48
【问题描述】：

我有两个单元格 A1 和 A2。我想合并它们并存储在 A3 中，保持格式不变。我能够使用下面的代码来做到这一点。但是有一个巨大的性能问题。任何人都可以提出更好的解决方案吗？有没有更简单的方法来做到这一点？

    Sub Merge_Cells(rngFrom1 As Range, rngFrom2 As Range, rngTo As Range)
    Dim iOS As Integer
    Dim lenFrom1 As Integer
    Dim lenFrom2 As Integer

        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlManual

       lenFrom1 = rngFrom1.Characters.Count
       lenFrom2 = rngFrom2.Characters.Count

      rngTo.Value = rngFrom1.Text & rngFrom2.Text

      For iOS = 1 To lenFrom1
        With rngTo.Characters(iOS, 1).Font
          .Bold = rngFrom1.Characters(iOS, 1).Font.Bold
          .Size = 9 'rngFrom1.Characters(iOS, 1).Font.Size
          .Color = rngFrom1.Characters(iOS, 1).Font.Color
          .Italic = rngFrom1.Characters(iOS, 1).Font.Italic
          .Strikethrough = rngFrom1.Characters(iOS, 1).Font.Strikethrough
          .Underline = rngFrom1.Characters(iOS, 1).Font.Underline
        End With
      Next iOS
      For iOS = 1 To lenFrom2
        With rngTo.Characters(lenFrom1 + iOS, 1).Font
         .Name = rngFrom2.Characters(iOS, 1).Font.Name
         .Bold = rngFrom2.Characters(iOS, 1).Font.Bold
         .Size = 9 'rngFrom2.Characters(iOS, 1).Font.Size
         .Color = rngFrom2.Characters(iOS, 1).Font.Color
         .Italic = rngFrom2.Characters(iOS, 1).Font.Italic
         .Strikethrough = rngFrom2.Characters(iOS, 1).Font.Strikethrough
         .Underline = rngFrom2.Characters(iOS, 1).Font.Underline

      End With
     Next iOS
     Application.Calculation = xlAutomatic
     Application.ScreenUpdating = True
     Application.EnableEvents = True 
    End Sub

【问题讨论】：

这个问题可能应该在codereview.stackexchange.com 而不是 SO。但是TBH，除非有一些我不知道的秘密捷径，否则它看起来还不错。像这样保留逐个字符格式的唯一方法是遍历字符。您表示存在“性能”问题，但这需要您多长时间才能应用于单元格？如果您从循环中调用它，那么问题很可能是迭代次数，而不是 this 过程。
谢谢大卫。由于我在第一个单元格 A1 (1k+) 中有很多字符，因此需要的时间太长（10+ 秒）。我正在寻找像单元格副本 A1 到 A3 之类的东西。将 A2 逐个字符附加到 A3 字符，或在带有格式的镜头中。有什么办法可以做到吗？如果我们可以这样做，性能可以提高 5 倍。在此先感谢
@DavidZemens codereview 应该用来做什么？？
@tannman357 我以前没有使用过它，但据我了解，它更适合“帮助我优化我的代码”，而 SO 更适合“Halp！我的代码已损坏/错误” /不起作用”。
@RanjithS 如果您先进行复制 (rngFrom1.Copy rngTo)，然后尝试重置 rngTo.Value = rngFrom1.Text & rngFrom2.Text 这不起作用。您丢失了一些复制的格式。

标签： vba excel merge formatting

【解决方案1】：

三个建议：

1.仅在需要时设置角色的属性

设置角色的属性可能比获取角色的属性更昂贵（我不确定）。如果成本差异足够高，那么在实际设置之前检查属性以查看是否需要设置是有意义的。

因此，例如，您的代码将变为：

Sub Merge_Cells2(rngFrom1 As Range, rngFrom2 As Range, rngTo As Range)
    Dim iOS As Integer
    Dim lenFrom1 As Integer
    Dim lenFrom2 As Integer

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlManual

    lenFrom1 = rngFrom1.Characters.Count
    lenFrom2 = rngFrom2.Characters.Count

    rngTo.Value = rngFrom1.Text & rngFrom2.Text

    For iOS = 1 To lenFrom1
        With rngTo.Characters(iOS, 1).Font
            If .Bold <> rngFrom1.Characters(iOS, 1).Font.Bold Then .Bold = rngFrom1.Characters(iOS, 1).Font.Bold
            If .Size <> 9 Then .Size = 9
            If .Color <> rngFrom1.Characters(iOS, 1).Font.Color Then .Color = rngFrom1.Characters(iOS, 1).Font.Color
            If .Italic <> rngFrom1.Characters(iOS, 1).Font.Italic Then .Italic = rngFrom1.Characters(iOS, 1).Font.Italic
            If .StrikeThrough <> rngFrom1.Characters(iOS, 1).Font.StrikeThrough Then .StrikeThrough = rngFrom1.Characters(iOS, 1).Font.StrikeThrough
            If .Underline <> rngFrom1.Characters(iOS, 1).Font.Underline Then .Underline = rngFrom1.Characters(iOS, 1).Font.Underline
        End With
    Next iOS
    For iOS = 1 To lenFrom2
        With rngTo.Characters(lenFrom1 + iOS, 1).Font
            If .Bold <> rngFrom2.Characters(iOS, 1).Font.Bold Then .Bold = rngFrom2.Characters(iOS, 1).Font.Bold
            If .Size <> 9 Then .Size = 9
            If .Color <> rngFrom2.Characters(iOS, 1).Font.Color Then .Color = rngFrom2.Characters(iOS, 1).Font.Color
            If .Italic <> rngFrom2.Characters(iOS, 1).Font.Italic Then .Italic = rngFrom2.Characters(iOS, 1).Font.Italic
            If .StrikeThrough <> rngFrom2.Characters(iOS, 1).Font.StrikeThrough Then .StrikeThrough = rngFrom2.Characters(iOS, 1).Font.StrikeThrough
            If .Underline <> rngFrom2.Characters(iOS, 1).Font.Underline Then .Underline = rngFrom2.Characters(iOS, 1).Font.Underline
        End With
     Next iOS
     Application.Calculation = xlAutomatic
     Application.ScreenUpdating = True
     Application.EnableEvents = True
End Sub

正如我所提到的，我真的不知道这是否是一场胜利，而且优势程度可能因财产而异。也许有人比我能评论的知识渊博。或者您可以尝试一下，看看是否有帮助。

2。一次性设置大小

由于您似乎一直将 size 设置为 9，我建议将整个单元格的 size 设置为 9，而不是逐个字符地设置。话又说回来，也许您将其注释掉是因为您打算恢复大小复制，如果是这样，此建议将不起作用。

3.利用稀疏性

如果格式是稀疏的，那么您可以在执行任何操作之前检查特定属性的长时间运行的字符（或整个单元格）。例如，如果许多单元格没有粗体，请在执行任何其他操作之前检查每个单元格。您可能根本不需要对加粗做任何事情。当属性在一系列字符中不一致时，我的 Excel 将返回 Null。 (ymmv) 如果你得到一个 Null，那么你知道你必须更精细地分割那个字符。

4.附录

@DavidZemens 关于字体大小的建议让我想到了这个想法，只有在 Set 比 Get 更昂贵的字符属性时才会得到回报。可以通过检查对最常见的字符样式（字体、大小、颜色、粗体等）进行猜测，手动将其定义为单元格样式并手动将其应用于目标范围。这将最大限度地减少触发属性集的 If 的数量。

-hth

【讨论】：

我只想把rngTo.Characters.Font.Size = 9 放在if/then 块之外，因为它统一应用于整个单元格内容，所以在单个字符级别这是不必要的操作，只需将其应用于整个单元格:) 这确实是唯一明显的改进空间。我还没有测试 Set vs. Get 的时间安排，但这是你提出的一个好点，可能值得研究。干杯。
3 明智的建议。如果 Get 和 Set 的时间很重要，那么我可以将具有相同属性的角色组合在一起，并为组分配 1 个集合 .Characters(Start:=1, Length:=6).Font 让我自己动手吧。我接受这个答案。谢谢。
谢谢@RanjithS。我对你的结果最感兴趣。
@DavidZemens，我同意从 if/thens 中提取字体大小。实际上，手动将其应用于整个目标范围可能是值得的。