Question

我有两个单元格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

Answer 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。一次设置大小

由于您似乎一直将大小设置为9，因此我建议将整个单元格的大小设置为9，而不是按字符设置。再说一遍，也许你评论它是因为你打算恢复大小复制，如果是这样，这个建议就不会起作用。

第3。利用稀疏性

如果格式化很稀疏，那么在执行任何操作之前，您可以检查特定属性的长字符（或整个单元格）。例如，如果许多单元格没有粗体，请在执行任何其他操作之前检查每个单元格。你可能根本不需要做任何关于粗体的事情。当一个属性在一系列字符中不均匀时，我的Excel将返回Null。（ymmv）如果你得到一个Null，那么你就知道你必须将这个角色切得更精细。

<强> 4。附录

@ DavidZemens＆＃39;关于字体大小的建议让我想到了这个想法，只有当Set比字符属性的Get更昂贵时才能获得回报。可以通过检查来形成对最常见字符样式（字体，大小，颜色，粗体等）的猜测，将其手动定义为单元格样式并手动将其应用于目标范围。这将最小化触发属性设置的If的数量。

-hth

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

1 个答案: