Vba 连接文本并将条件格式保留为静态

我有一个有两行的表，其中包含条件格式（规则如“如果低于”则为“彩色文本”）。我需要连接这两行，并分别保留每行的格式。因此，我不能仅仅连接值和粘贴格式，因为它将对整个文本而不仅仅是部分文本应用条件格式

我搜索了解决方案，发现可以使用Range.DisplayFormat属性将条件格式转换为静态格式。在我的代码中，我基本上是按每个字符进行的 从源单元格复制DisplayFormat（使用条件格式），并对目标范围内的字符使用相同的字体、大小、粗体和颜色

结果应该如下所示：

不幸的是，我得到的只是一个没有格式化的连接字符串。你知道更好的方法来实现我的需求吗？或者你能帮我修复现有的代码吗

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

  Set rngFrom1 = Cells(59, 1) 'first row
  Set rngFrom2 = Cells(60, 1) 'second row
  Set rngTo = Cells(64, 1)
  lenFrom1 = Len(rngFrom1)
  lenFrom2 = Len(rngFrom2)

  rngTo.Value = rngFrom1.Text & " " & rngFrom2.Text 'concatenating text

  For i = 1 To lenFrom1
    With rngTo.Characters(i, 1).Font
      .Name = rngFrom1.DisplayFormat.Characters(i, 1).Font.FontStyle
      .Bold = rngFrom1.DisplayFormat.Characters(i, 1).Font.Bold
      .Size = rngFrom1.DisplayFormat.Characters(i, 1).Font.Size
      .ColorIndex = rngFrom1.DisplayFormat.Characters(i, 1).Font.ColorIndex
    End With
  Next i

  For i = 1 To lenFrom2
    'start from character that is after space
    With rngTo.Characters(lenFrom1 + 1 + i, 1).Font 
      .Name = rngFrom2.DisplayFormat.Characters(i, 1).Font.Name
      .Bold = rngFrom2.DisplayFormat.Characters(i, 1).Font.Bold
      .Size = rngFrom2.DisplayFormat.Characters(i, 1).Font.Size
      .ColorIndex = rngFrom2.DisplayFormat.Characters(i, 1).Font.ColorIndex
    End With
  Next i
End Sub

---

通过将我的源代码区域和所有条件格式复制到Word并将其粘贴回Excel到另一个区域，我已经部分实现了我想要的功能。这样可以保留格式，但没有条件格式的规则，所有字体参数都可以被我的宏读取。唯一的问题是当使用非标准颜色时，因为它们在Excel和Word中不同（例如红色变为粉红色）

---

是否要对字符串的“一半”应用条件格式？不支持连接单元格的部分格式：请参阅我对总值行和增量行中的值使用条件格式。我想连接这两行中的值，同时保留每行的格式。根据我的理解，这不能用条件格式来完成，所以我想将它转换为字符串每“一半”的静态格式。这就是为什么我要用它来给每个角色上色。如果源格式是静态的，而不是有条件的，它就可以工作。你是如何制作问题中的图片的？用油漆？还是Excel的截图？@Seidhe只是将a的格式设置为右侧，将B的格式设置为左侧。这样看起来几乎一样。正如您在我上面的链接中所看到的，Excel不支持连接单元格的部分格式。你可以看看这里，这是一个类似的问题。

Sub Merge_Cells()
Dim i As Integer
Dim rngFrom1 As Range
Dim rngFrom2 As Range
Dim rngTo As Range
Dim lenFrom1 As Integer
Dim lenFrom2 As Integer
Dim objWord As Object
Dim objDoc As Object
Dim rngcopy As Range
Dim ws As Worksheet

Set ws = Sheets("test")
ws.Visible = True
ws.Activate    
Set rngcopy = Range("C51", "C53")
rngcopy.Select
' Copy Excel Selection
Selection.Copy

' Create new Word Application
Set objWord = CreateObject("Word.Application")
objWord.Visible = False

' Create new Word Document
Set objDoc = objWord.Documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0)

' Paste Excel range into Word document
objWord.Selection.PasteExcelTable False, False, True

' Copy text from cells
If objDoc.Tables.Count >= 1 Then
    objDoc.Tables(1).Select
    objWord.Selection.Copy
End If

' Close Microsoft Word and not save changes
objWord.Quit False
Set objWord = Nothing
'Paste it back to Excel
ws.Range("C58").Activate
ws.Paste

'Old code
Set rngFrom1 = Cells(59, 3) 'first row
Set rngFrom2 = Cells(60, 3) 'second row
Set rngTo = Cells(64, 3)
lenFrom1 = Len(rngFrom1)
lenFrom2 = Len(rngFrom2)
rngTo.Value = rngFrom1.Text & " " & rngFrom2.Text 'concatenating text

For i = 1 To lenFrom1
    With rngTo.Characters(i, 1).Font
      .Name = rngFrom1.DisplayFormat.Characters(i, 1).Font.FontStyle
      .Bold = rngFrom1.DisplayFormat.Characters(i, 1).Font.Bold
      .Size = rngFrom1.DisplayFormat.Characters(i, 1).Font.Size
      .ColorIndex = rngFrom1.DisplayFormat.Characters(i, 1).Font.ColorIndex
    End With
Next i

For i = 1 To lenFrom2
    'start from character that is after space
    With rngTo.Characters(lenFrom1 + 1 + i, 1).Font 
      .Name = rngFrom2.DisplayFormat.Characters(i, 1).Font.Name
      .Bold = rngFrom2.DisplayFormat.Characters(i, 1).Font.Bold
      .Size = rngFrom2.DisplayFormat.Characters(i, 1).Font.Size
      .ColorIndex = rngFrom2.DisplayFormat.Characters(i, 1).Font.ColorIndex
    End With
Next i

End Sub