1

Тема: Сортировка блоков по алфавиту

Здравствуйте. Приложил файл. Требуется отсортировать по алфавиту слева направо и сверху вниз. Т.е. первые слова блоков идут по порядку слева направо и вниз дальше. Как это возможно осуществить?

2

Re: Сортировка блоков по алфавиту

Файл не приложен.

3

Re: Сортировка блоков по алфавиту

aap77 пишет:

Файл не приложен.

Прошу прощения, приложил

Post's attachments

Наклейки.docx 67 Кб, 3 скачиваний с 2012-10-17 

You don't have the permssions to download the attachments of this post.

4

Re: Сортировка блоков по алфавиту

Отправил Вам на почту сообщение.

5

Re: Сортировка блоков по алфавиту

Так пойдёт?

  1. Удалил лишние пробелы (" {2;}" заменить на "", подстановочные знаки включены)

  2. Удалил пустые абзацы ("^p^p" заменить на "", подстановочные знаки выключены)

  3. Удалил пустые абзацы в начале и в конце ячеек (макросом)

  4. Заменил абзацы на условные символы $$ ("^p" заменить на "$$", подстановочные знаки выключены)

  5. Преобразовал таблицу в текст, разделитель — абзац. Каждая ячейка стала одним абзацем

  6. Отсортировал абзацы по алфавиту

  7. Преобразовал текст в таблицу с двумя столбцами, разделитель — абзац, ширина — по ширине окна

  8. Заменил условные символы $$ на абзацы ("$$" заменить на "^p", подстановочные знаки выключены)

  9. Задал высоту строк 3,85 см как в исходном документе

Макросы:

'Удаление знака абзаца в начале ячейки
Sub DeleteLastParagraphInCell()
    Dim oCell As Cell
    For Each oCell In Selection.Tables(1).Range.Cells
        If oCell.Range.Characters.First.Text = ChrW(13) Then oCell.Range.Characters.First.Delete
    Next
End Sub

'Удаление знака абзаца в конце ячейки
Sub DeleteLastParagraphInCell()
    Dim oCell As Cell
    For Each oCell In Selection.Tables(1).Range.Cells
        If oCell.Range.Characters.Last.Previous.Text = ChrW(13) Then oCell.Range.Characters.Last.Previous.Delete
    Next
End Sub

'Преобразование всех таблиц в текст
Sub AllTablesToText()
    Dim oTbl As Table
    For Each oTbl In ActiveDocument.Tables
        oTbl.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
        NestedTables:=True
    Next
End Sub
Post's attachments

Наклейки (испр).docx 52.23 Кб, 1 скачиваний с 2012-10-22 

You don't have the permssions to download the attachments of this post.
Лучше день потерять — потом за пять минут долететь!