MS Word 2010, макросы: Удалить строки в таблице по условию

Автор lapin9126, 16 мая 2017, 07:41

lapin9126

Здравствуйте. Как сделать макрос, который бы делал следующее.
Если текст в столбце 2 выравнен по центру, то с этой строкой ничего не делать.
В столбце 2 нужно оставлять только две начальные строки, которые разделены знаком ^0011.
Если в столбце 1 пусто, а в столбце 2 нет символа ^0011, то данные в столбце 2 удалить.
Если в столбце 1 непусто, а в столбце 2 нет символа ^0011, то данные в столбце не удалять.

В примере то что нужно оставить выделил зеленым цветом, то что удалить - красным.


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

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

Макрос работает с таблицей, в которой находится курсор, или которая выделена.
Макрос работает со строки 4 до последней.

Макрос
Sub Макрос()
   
    Dim tbl As Table, text, i As Long
   
   
    '1. Отключение монитора (может это ускорит макрос).
    Application.ScreenUpdating = False
   
    '2. Присваиваем имя таблице, в которой находится курсор или которая выделена.
    Set tbl = Selection.Tables(1)
   
    '3. Движение по строкам таблицы со строки 4 до последней.
    For i = 4 To tbl.Rows.Count
       
        '1) Проверка, нужно ли обрабатывать эту строку. Если в столбце 2 текст по центру,
            ' то такую строку не надо обрабатывать.
        If tbl.Cell(i, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter Then
            GoTo metka_NextRow
        End If

        '2) Копирование текста из столбца 2 в переменную, чтобы было удобнее ориентироваться в коде
            ' и ещё это ускорит работу макроса, т.к. с переменной быстрее работать, чем с объетом.
        text = tbl.Cell(i, 2).Range.text
       
        '3) Удаление спецсимволов, которые находятся в конце ячейки, чтобы они не вставлялись обратно в ячейку.
        text = Left(text, Len(text) - 2)
       
        '4) Если в ячейке нет символа "разрыв строки".
        If InStr(text, Chr(11)) = 0 Then
            ' Если в столбце 1 пусто, то строка удаляется.
            If tbl.Cell(i, 1).Range.Characters.Count = 1 Then
                tbl.Cell(i, 2).Range.text = ""
            End If
            GoTo metka_NextRow
        End If
       
        '5) Рзабивка текста ячейки на части по символу "разрыв строки".
        text = Split(text, Chr(11))
       
        '6) Запись в ячейку первого и второго элемента.
        tbl.Cell(i, 2).Range.text = text(0) & Chr(11) & text(1)
       
metka_NextRow:
    Next i
   
    '4. Включение монитора.
    Application.ScreenUpdating = True

End Sub
[свернуть]

lapin9126