如何使用 VBA 组合这两个字符串,同时保持字体和颜色相同?

How can I combine these two strings using VBA while keeping the fonts and colors the same?

我试图使两个文本的特征保持一致。我想要做的就是从 A 列第 1 行中获取文本,并确保它在 B 列第 1 行中重复。如果是,我什么都不用做。如果不是,那么我需要做的就是从第一个框中取出文本,将其划掉,将其设为红色,然后将其添加到框 2 中的文本中。

我怎样才能做到这一点?我尝试将文本作为字符串分配给变量,但是当我尝试组合它时,所有颜色都变成黑色。有什么简单的方法吗?

Inputs Desired Output

我是 VBA 的新手,如有任何帮助,我们将不胜感激!

至于我的代码,这是我目前的代码,但我想我必须完全重写它。

       x = Cells(i, 1) & "" & " "
    w = Cells(i, 2)
    If InStr(LCase(Cells(i, 2)), LCase(x)) = 0 Then
        full = x & "" & w
        Cells(i, 2) = full
    End If
    For lcounter = 1 To Len(Cells(i, 1))
        If Cells(i, 1).Characters(lcounter, 1).Text = Cells(i, 2).Characters(lcounter, 1).Text And Cells(i, 2).Characters(lcounter, 1).Font.ColorIndex = 3 Then
            Cells(i, 2).Characters(lcounter, 1).Font.Strikethrough = True
            Cells(i, 2).Characters(lcounter, 1).Font.ColorIndex = 3
        End If
    Next lcounter

此代码仅在合并前单元格 2 中的所有文本均为红色时才有效。出于某种原因,如果是这种情况,组合文本也是红色的。 但除此之外,对于图片中的示例,此代码不起作用。

格式字符

Sub FormatCharacters()

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range: Set rg = ws.Range("A1:B1")

    Dim Cell1 As Range: Set Cell1 = rg.Cells(1)
    Dim Cell2 As Range: Set Cell2 = rg.Cells(2)
        
    If Cell1.Value <> Cell2.Value Then
                
        ' Write the formats of the 2nd cell to an array.
        
        Dim Len1 As Long: Len1 = Len(Cell1)
        Dim Len2 As Long: Len2 = Len(Cell2)
    
        Dim LB As Long: LB = Len1 + 2
        Dim UB As Long: UB = LB + Len2 - 1
        
        Dim arr2() As Variant: ReDim arr2(LB To UB, 1 To 2)
        Dim j As Long: j = LB
        
        Dim i As Long
                
        For i = 1 To Len2
            With Cell2.Characters(i, 1).Font
                arr2(j, 1) = .Color
                arr2(j, 2) = .Strikethrough
                j = j + 1
            End With
        Next i
    
        ' Concatenate the strings.
        
        Cell2.Value = Cell1.Value & " " & Cell2.Value
        
        ' Format the 1st cell's string.
        
        With Cell2.Characters(1, Len1).Font
            .Color = vbRed
            .Strikethrough = True
        End With
        
        ' Format the 2nd cell's string.
        
        For j = LB To UB
            With Cell2.Characters(j, 1).Font
                .Color = arr2(j, 1)
                .Strikethrough = arr2(j, 2)
            End With
        Next j
                
    End If
            
End Sub