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

Question

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

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