斜体字体未复制

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

好的，那很有趣。首先编写代码，然后再谈：

Public Sub MergeAndFormat()

    Const originalColumn As Long = 1
    Const formattedColumn As Long = 3

    Dim lastRow As Long
    lastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row

    Dim currentEntry As Long

    Dim currentRow As Long
    For currentRow = 1 To lastRow

        Dim currentCell As Range
        Set currentCell = Sheet1.Cells(currentRow, originalColumn)

        Dim currentText As String
        currentText = currentCell.Value
        ' ensure we have a space at the end of the line
        If Right$(currentText, 1) <> " " Then currentText = currentText & " "

        Dim isNewEntry As Boolean 'new entry if first char is bold
        isNewEntry = currentCell.Characters(1, 1).Font.Bold

        Dim currentCharOffset As Long
        Dim currentEntryText As String
        If isNewEntry Then
            currentEntry = currentEntry + 1
            currentEntryText = currentText
            currentCharOffset = 1
        Else
            currentCharOffset = Len(currentEntryText) + 1
            currentEntryText = currentEntryText & currentText
        End If

        Dim entryCell As Range
        Set entryCell = Sheet1.Cells(currentEntry, formattedColumn)
        If isNewEntry Then entryCell.Value = vbNullString

        'append the source characters, without losing formatting in the entryCell
        entryCell.Characters(currentCharOffset + 1).Insert currentText

        Dim currentIndex As Long
        For currentIndex = 1 To currentCell.Characters.Count

            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Bold = currentCell.Characters(currentIndex, 1).Font.Bold
            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Italic = currentCell.Characters(currentIndex, 1).Font.Italic
            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Underline = currentCell.Characters(currentIndex, 1).Font.Underline
            entryCell.Characters(currentCharOffset + currentIndex - 1, 1).Font.Strikethrough = currentCell.Characters(currentIndex, 1).Font.Strikethrough

        Next

    Next

End Sub

整个循环逻辑被单字母变量名称所遮盖，所涉及的数据类型被 type hint 字符所遮盖，并且变量的意图也被遮盖了，因为变量的含义取决于您正在查看的是哪行代码（例如，uneditedColumn的值为1 巧合可以理解为Length属性的Range.Characters自变量

所以我把所有东西都烧掉了，并重写了整个逻辑。

我们知道“原始”文本的开始位置和结束位置-我们不需要无限的Do While循环：相反，我们可以弄清楚lastRow是什么，我们使用一个For...Next循环，它以lastRow作为out计数器，从顶部开始并结束于currentRow是什么。

由于我们使用currentRow来计算原始列中的位置，因此我们将currentCell用于表示该特定“当前单元格”的Range对象，以及{ {1}}将保留该单元格文本的字符串值。

然后，我们需要知道是否要查看“新条目”，或者是否要继续上一个条目-如果{{1的第一个字符，则currentText是isNewEntry }}为粗体。

当True为currentCell时，我们增加isNewEntry计数器（在第一次为它分配第一个“新条目”之前，它一直为0），所以我们知道我们在哪一行打算写信给； True将与currentEntry匹配，并且字符格式偏移量将位于位置1。

当currentEntryText为currentText时，我们不增加isNewEntry计数器（我们将附加到该单元格的文本上），并计算新的字符格式偏移量通过为当前条目的整个文本长度加1- then ，我们更新False来附加currentEntry-不是因为我们需要文本本身，而是因为我们将在下一次迭代中使用它来计算新的字符偏移量。

这时，我们知道该写什么，以及在哪里写-仅在currentEntryText级别上工作时，我们将覆盖上一次迭代中所做的所有操作，并丢失格式...而且我们不想要，所以这就是我们跟踪这些偏移量的原因...

我们在currentText当前内容的末尾Range Insert，然后开始迭代currentText中的字符，并照原样复制格式-通过跟踪的字符来补偿字符。

上面的代码保留entryCell，currentCell，Bold和Italic的格式；对其进行更改以也支持Underline和Strikethrough格式应该是微不足道的。