Здравствуйте. Как сделать макрос, который бы делал следующее.
Если текст в столбце 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