如何使用VBA合並Excel中的兩個單元格（均包含內容），以保持格式完整？

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關於字體大小的建議使我想到了這個主意，只有在Set的字符屬性比Get貴的情況下，這種想法才會奏效。 通過檢查，可以推測出最常見的字符樣式（字體，大小，顏色，粗體等），將其手動定義為單元格樣式，然后手動將其應用於目標范圍。 這樣可以最大程度地減少觸發屬性集的If的數量。

-hth