Word Макросы: Удалить пустое место в ячейках (строках) в таблице

[Anton]

Добрый день!
У меня есть огромные таблицы. В большом количестве ячеек в конце есть ненужные абзацы и пустые строки. Можно ли как-то в таблице их всех скопом отформатировать, чтобы убрать пустые абзацы и строки, а также подтянуть, если возможно, границу к тексту? Пример как есть и как надо сделать приложил.

[вложение удалено администратором]

[Администратор]

Макрос может долго работать, т.к. просматривается каждая ячейка, а в каждой ячейке просматриваются с конца абзацы до первого непустого. Такие действия в VBA очень медленные.

Макрос

Sub Удалить_пустые_абзацы()

    Dim tbl As Table, cel As Cell, i As Long
   
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Vba-именование таблицы, в которой находится текстовый курсор.
    Set tbl = Selection.Tables(1)
   
    '3. Цикл по всем ячейкам таблицы.
    For Each cel In tbl.Range.Cells
   
        ' Цикл по всем абзцам (от последнего к первому) ячейки.
            ' Один первый абзац в ячейке всегда будет и его нельзя удалить,
            ' поэтому просматриваются все абзацы кроме первого.
        For i = cel.Range.Paragraphs.Count To 2 Step -1
       
            ' Просмотр, что находится в абзаце.
            Select Case cel.Range.Paragraphs(i).Range.Text
                ' Если абзац пустой.
                Case Chr(13) & Chr(7)
                    ' Удаление в вышестоящем абзаце на конце символа абзаца.
                    cel.Range.Paragraphs(i).Previous.Range.Characters.Last.Delete
                ' Если в абзаце есть символ табуляции.
                Case Chr(9) & Chr(13) & Chr(7)
                    ' Удаление символа табуляции.
                    cel.Range.Paragraphs(i).Range.Characters(1).Delete
                    ' Удаление в вышестоящем абзаце на конце символа абзаца.
                    cel.Range.Paragraphs(i).Previous.Range.Characters.Last.Delete
                ' Если в абзаце текст, то переход к следующей ячейке.
                Case Else
                    Exit For
            End Select
           
        Next i
    Next cel
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]

[Anton]

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

[Администратор]

Удаляются два символа: символ табуляции и символ "знак абзаца". Больше ничего не удаляется.
Удаляется только с конца ячейки; внутри ячейки - между текстами - ничего не удаляется.

[Anton]

Понял. Спасибо!