Question

我有连接一些字符串的代码。

例如：

之前

现在

我想看

问题是未编辑的字符串带有斜体字，但是当我尝试连接此字符串时，斜体字变得没有此字体，该如何编辑代码？

Sub MergeText()

    Dim strMerged$, r&, j&, i&, uneditedColumn As Long, resultColumn As Long
    With ThisWorkbook.Worksheets("Sheet1") 'Change sheet name if needed
    uneditedColumn = 1 ' Column number which need to edit !!! uneditedColumn must not be equal resultColumn
    resultColumn = 3 ' Column number where need to put edited text
    r = 1
    Do While True
        If Cells(r, uneditedColumn).Characters(1, uneditedColumn).Font.Bold Then
            strMerged = "": strMerged = Cells(r, uneditedColumn)
            r = r + 1
            While (Not Cells(r, uneditedColumn).Characters(1).Font.Bold) And Len(Cells(r, uneditedColumn)) > 0
                strMerged = strMerged & " " & Cells(r, uneditedColumn)
                r = r + 1
            Wend
            i = i + 1: Cells(i, resultColumn) = strMerged
            Cells(i, resultColumn).Characters(1, InStr(1, strMerged, ".", vbTextCompare)).Font.Bold = True
        Else
            Exit Do
        End If
    Loop
End With
End Sub

Answer 1

我已经这样做了：

使用未编辑行的第一个字符设置为 BOLD 格式的规则，将每个结果行开始的规则连接字符串。
在处理每个未编辑行时，请使用集合对象将每个字符字体Bold和Italic属性存储在字典中。字典键是结果范围内的行号；收集项由一个描述Bold和Italic的character.font属性的数组组成。
事物的本质是，收集项目编号将与结果字符串中的字符位置相对应。

Option Explicit
Sub copyWithFormat()
    Dim WS As Worksheet
    Dim rUnedited As Range, rResult As Range, C As Range
    Dim S As String
    Dim I As Long, J As Long, K As Long
    Dim Dict As Object, Col As Collection

Set WS = Worksheets("sheet2")
With WS
    Set rUnedited = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    Set rResult = .Cells(1, 3)
End With

rResult.EntireColumn.Clear

Set Dict = CreateObject("Scripting.Dictionary")

I = 0  'rResult rows
For Each C In rUnedited
    Select Case C.Characters(1, 1).Font.Bold
        Case True 'start of a string
            I = I + 1
            rResult(I, 1) = C
            Set Col = New Collection
                For J = 1 To Len(C)
                    Col.Add Array(C.Characters(J, 1).Font.Bold, C.Characters(J, 1).Font.Italic)
                Next J
                Dict.Add Key:=I, Item:=Col
        Case False
            rResult(I, 1) = rResult(I, 1) & " " & C
            Dict(I).Add Array(False, False) 'for the intervening space
            For J = 1 To Len(C)
                Dict(I).Add Array(C.Characters(J, 1).Font.Bold, C.Characters(J, 1).Font.Italic)
            Next J
    End Select
Next C

'Format the characters
Set rResult = Range(rResult(1, 1), rResult.End(xlDown))

I = 0
For Each C In rResult
    I = I + 1
    For J = 1 To Dict(I).Count
        C.Characters(J, 1).Font.Bold = Dict(I)(J)(0)
        C.Characters(J, 1).Font.Italic = Dict(I)(J)(1)
    Next J
Next C
End Sub

未编辑 （请注意，我从您原来的格式中添加了一些粗体和斜体格式）

结果

如何从字符串中保存斜体字体样式？

1 个答案: