Курсив не скопирован

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

Вся логика цикла была скрыта однобуквенными именами переменных, используемые типы данных были скрыты подсказкой типа символов, а назначение переменных было скрыто, поскольку значение переменной менялось в зависимости от того, что строка кода, которую вы просматривали (например, uneditedColumn со значением 1 по совпадению , что имеет смысл в качестве аргумента Length для свойства Range.Characters.

Итак, я сжег все до основания и переписал всю логику.

Мы знаем, где начинается «оригинальный» текст и где он заканчивается - нам не нужен почти бесконечный цикл Do While: вместо этого мы выясняем, что такое lastRow, и используем For...Next Цикл, который начинается сверху и заканчивается на lastRow, используя currentRow в качестве счетчика.

Поскольку мы используем currentRow для подсчета того, где мы находимся в исходном столбце, мы будем использовать currentCell для объекта Range, представляющего эту конкретную "текущую ячейку", а currentText будет содержать строку значение текста этой ячейки.

Затем нам нужно знать, смотрим ли мы на «новую запись» или продолжаем предыдущую - isNewEntry равно True, если первый символ currentCell выделен жирным шрифтом.

Когда isNewEntry равен True, мы увеличиваем счетчик currentEntry (который равен 0, пока мы не назначим его первой «новой записи»), чтобы мы знали, в какую строку мы будем записывать; currentEntryText будет соответствовать currentText, и смещение форматирования будет в позиции 1.

Когда isNewEntry равен False, мы не увеличиваем счетчик currentEntry (вместо этого мы будем добавлять текст этой ячейки), и мы вычисляем новое смещение форматирования символов, добавляя 1 к длине всего текста для текущей записи - , затем мы обновляем currentEntryText, чтобы добавить currentText - не потому, что нам нужен сам текст, а потому, что он нам понадобится на следующей итерации для вычисления нового смещение символа.

На данный момент мы знаем, что писать и куда писать - только если мы будем работать на уровне Range, мы перезапишем все, что мы делали в предыдущей итерации, и потеряем форматирование. И мы не хотим этого, поэтому мы отслеживаем эти смещения ...

Мы Insert currentText в конце текущего содержимого entryCell, а затем мы начинаем итерацию символов в currentCell и буквально копируем форматирование - смещая символы на то, что мы ' мы отслеживаем.

Приведенный выше код сохраняет форматирование Bold, Italic, Underline и Strikethrough; изменение его также для поддержки форматов Subscript и Superscript должно быть тривиальным.