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

Question

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

我搜索了解决方案，发现您可以使用 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

Answer 1

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

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