Автор использовал Excel как печатную машинку - для экспорта необходимо объединить ячейки по вертикали с VBA

Question

Кто-то создал текстовый документ в Excel, как это было на пишущей машинке, поэтому они написали до конца экрана и затем нажали клавишу Enter.Теперь мне нужен этот документ для чтения на других экранах.Я хотел бы поместить каждый абзац в отдельную ячейку, а затем скопировать и вставить в слово.Если есть лучший способ сделать это, я весь слух.

Я пытался записать макрос, но он застрял между абзацами (автор пропустил строку между абзацами).Мое исследование показывает объединение ячеек по одной, что не поможет мне с примерно 1000 строками текста.

Я открыт для использования макроса, но я думаю, что VBA будет лучше.Что-то вроде:

' If cell below isn't empty

' then

' activecell=activecell&activecell(0,1)

' delete activecell(0,1)

' else activecell(0,2).select

'endif

'loop 1000 times

Если в текущем документе написано:

A boy walked down
the street.

Next he tried
to run.

Finally this task
was over.

Это будет выглядеть примерно так:

A boy walked down the street.

Next he tried to run.

Finally this task was over.

Тогда я скопирую его в слово,Спасибо!

Answer 1

Если мои предположения верны, попробуйте следующее:

1. Скопируйте все в Word.

2. Выполните поиск / замену для двух каретоквозвращает (^p^p) и заменяет их строкой-заполнителем (например: %%%%%, все будет делать, если это не в вашем документе)

3. Выполнить поиск /Заменить на возврат каретки (^p) и заменить их на один пробел ()

4. Выполнить поиск / замену для строки заполнителя (%%%%% в моем примеревыше) и замените его двумя возвратами каретки (^p^p)

5. Возможно, вам потребуется выполнить поиск / замену в двойных пробелах и заменить их одинарными пробелами.

После проверки и, возможно, некоторых настроек, все должно быть сделано.

Answer 2

Дополнительная опция, текст можно скопировать из непосредственного окна после запуска макроса. Вы можете получить к нему доступ через View или Ctrl + G в окне разработчика VBA.

Sub Concatenate_Text()
Dim i As Long
Dim lastrow As Long
Dim paragraph As String

Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")

lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastrow
    If IsEmpty(ws.Cells(i, "A")) = False Then
    paragraph = paragraph & " " & ws.Cells(i, "A").Value & " " & ws.Cells(i + 1, "A").Value
    i = i + 1
    Else: paragraph = paragraph & vbCrLf
    End If

Next i

Debug.Print paragraph

End Sub

Answer 3

Другой вариант

Sub compileDoc()
    Dim textArr(), r As Long, n As Long, curPar As String

    textArr = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Value
    n = LBound(textArr)
    For r = LBound(textArr) To UBound(textArr)
        If Len(textArr(r, 1)) Then
            curPar = curPar & " " & textArr(r, 1)
            textArr(r, 1) = ""
        Else
            textArr(n, 1) = WorksheetFunction.Trim(curPar)
            n = n + 1
            curPar = ""
        End If
    Next r
    textArr(n, 1) = curPar
    Sheet1.Range("B2:B" & n + 1) = textArr
End Sub