Макрос для worda

[Prince1991]

Добрый день, уважемые форумчане...
Вообщем такая проблема, не могли бы подсказать, как правильно написать скрипт на VBA, работать должен вот так(пример):
Дается текст:

15.25 "ИНТЕРНЫ". Ситком.
16.00 "ИНТЕРНЫ". Ситком.
16.30 "ИНТЕРНЫ". Ситком.

Нужно чтобы было вот так:

15.25, 16.00, 16.30 "ИНТЕРНЫ". Ситком.

Или еще вот так (к примеру):
Дается текст:

15.25 "ИНТЕРНЫ". Ситком.
16.00 "УНИВЕР". Ситком.
16.30 "ИНТЕРНЫ". Ситком.

Нужно чтобы было вот так:

15.25, 16.30 "ИНТЕРНЫ". Ситком.
16.00 "УНИВЕР". Ситком.

Помогите решить.

[viter.alex]

Программа телепередач, можно сделать. Вы сами будете делать?

[Prince1991]

Сообщение от viter.alex

Программа телепередач, можно сделать. Вы сами будете делать?

Да хотелось бы, но на некоторых моментах я остановился, а именно первый это то что написано в первом сообщении. Как сделать не пойму, уже два месяца бьюсь.

[Sasha_Smirnov]

Ну тут грех не сослаться на всеобъемлющую тему http://programmersforum.ru/showthread.php?t=37792!

Правда, там, так сказать, межканальная (а не внутренняя) структуризация.

[foreytor]

Сообщение от Prince1991

Да хотелось бы, но на некоторых моментах я остановился, а именно первый это то что написано в первом сообщении. Как сделать не пойму, уже два месяца бьюсь.

Как вариант, можно попробовать такой вот макрос:
-
Sub YourMacros_123()

' возвращаем из текста значения всех параграфов в виде содержание-время;
' последовательно присваиваем значение "содержания" параграфа ключу словаря, а время - его значению;
' если в словаре уже имеется ключ = "значение", то время добавляется через запятую с пробелом;
' созданный словарь передается в массив для сортировки по первой величине времени;
' значения из массива передаются в текст документа.

Const countFirstLetter = 5 ' количество символов в начале строки, отводимое под значение времени
Const delimChar = "." ' разделитель знаков в значении времени

Dim dicParagraphsContents ' словарь (хеш-таблица) в которой ключами будут содержания параграфов, а их значением - время по накопительной
Dim arrNewParagraphs ' так как сортировать хеш-таблицу по значениям - дело неблагодарное, будем сортировать значения времени в массиве
Dim arrContent(2) ' маленький массив, первое значение которого будет = содержание строки, второе = время, послужит для ускорения обработки данных и упрощения кода
Dim i, j ' счетчики

Set dicParagraphsContents = CreateObject("Scripting.Dictionary" ) ' создали словарь

' ШАГ 1 - наполняем словарь данными из параграфов документа
' если имеется хотя бы один открытый документ (обычная формальность)
If Application.Documents.Count >= 1 Then
With ActiveDocument.Paragraphs ' возвращаем коллекцию параграфов активного документа
' если найден хотя бы один параграф (еще одна обычная формальность)
If .Count >= 1 Then
' последовательное преобразование параграфов в словарь
For i = 1 To .Count
' ообходим некачественные строки
If Len(.Item(i).Range.Text) > countFirstLetter Then
' разбиваем параграф на две части: 0 = содержание, 1 = время
' PS помимо удаления пробелов в этом месте можно добавить любое форматирование, например "15 час. 12 мин."
arrContent(0) = Trim(Right(.Item(i).Range.Text, Len(.Item(i).Range.Text) - countFirstLetter))
arrContent(1) = Trim(Left(.Item(i).Range.Text, countFirstLetter))
' если параграф начинается с символов, которые можно преобразовать в число
' (если этого недостаточно - можно создать функцию проверки на валидность значения времени, внедрив его в функцию IsDate)
If IsNumeric(Replace(arrContent(1), delimChar, "")) Then

' выясняем - имеется ли уже значение строки в словате
If dicParagraphsContents.Exists(arrCon tent(0)) Then
' если ключ имеется - дописываем время
dicParagraphsContents.Item(arrConte nt(0)) = dicParagraphsContents.Item(arrConte nt(0)) & ", " & arrContent(1)
Else
' если ключа нет - просто добавляем строку
dicParagraphsContents.Item(arrConte nt(0)) = arrContent(1)
End If

End If
End If
' -> здесь можно удалить содержание параграфа
Next

End If
End With
Else ' окончание обычной формальности
MsgBox "Отсутствует активный документ", 48
Exit Sub
End If

' ШАГ 2 - передаем созданные значения в массив и сортируем его по значениям времени
' инициализируем массив необходимого размера (словаря)
ReDim arrNewParagraphs(2, dicParagraphsContents.Count)

' передали в массив данные из словаря
' PS в этом месте так же можно добавить любое форматирование, например заменить скобки на кавычки или...
For i = 0 To UBound(arrNewParagraphs, 2) - 1
arrNewParagraphs(1, i) = dicParagraphsContents.Keys()(i) ' это водержание
arrNewParagraphs(0, i) = dicParagraphsContents.Item(arrNewPa ragraphs(1, i)) ' это время (перечисление)
Next

' сортируем массив (сокращаю постинг - длинный)
' ШАГ 3 - передаем параграфы из массива в документ
With ActiveDocument.Paragraphs ' возвращаем коллекцию параграфов активного документа
For i = 0 To UBound(arrNewParagraphs, 2) - 1
.Add
.Item(.Count).Range.Text = arrNewParagraphs(0, i) & " " & arrNewParagraphs(1, i)
Next
End With

End Sub
-

Я его тестировал на весьма примитивном документе - 5 строк, так что ...
Можно макрос применить, как функцию более большой программы, передав в него кусок коллекции параграфов.

[Prince1991]

Сообщение от foreytor

Как вариант, можно попробовать такой вот макрос:
Sub YourMacros_123()

' возвращаем из текста значения всех параграфов в виде содержание-время;
' последовательно присваиваем значение "содержания" параграфа ключу словаря, а время - его значению;
' если в словаре уже имеется ключ = "значение", то время добавляется через запятую с пробелом;
' созданный словарь передается в массив для сортировки по первой величине времени;
' значения из массива передаются в текст документа.

Const countFirstLetter = 5 ' количество символов в начале строки, отводимое под значение времени
Const delimChar = "." ' разделитель знаков в значении времени

Dim dicParagraphsContents ' словарь (хеш-таблица) в которой ключами будут содержания параграфов, а их значением - время по накопительной
Dim arrNewParagraphs ' так как сортировать хеш-таблицу по значениям - дело неблагодарное, будем сортировать значения времени в массиве
Dim arrContent(2) ' маленький массив, первое значение которого будет = содержание строки, второе = время, послужит для ускорения обработки данных и упрощения кода
Dim i, j ' счетчики

Set dicParagraphsContents = CreateObject("Scripting.Dictionary" ) ' создали словарь

' ШАГ 1 - наполняем словарь данными из параграфов документа
' если имеется хотя бы один открытый документ (обычная формальность)
If Application.Documents.Count >= 1 Then
With ActiveDocument.Paragraphs ' возвращаем коллекцию параграфов активного документа
' если найден хотя бы один параграф (еще одна обычная формальность)
If .Count >= 1 Then
' последовательное преобразование параграфов в словарь
For i = 1 To .Count
' ообходим некачественные строки
If Len(.Item(i).Range.Text) > countFirstLetter Then
' разбиваем параграф на две части: 0 = содержание, 1 = время
' PS помимо удаления пробелов в этом месте можно добавить любое форматирование, например "15 час. 12 мин."
arrContent(0) = Trim(Right(.Item(i).Range.Text, Len(.Item(i).Range.Text) - countFirstLetter))
arrContent(1) = Trim(Left(.Item(i).Range.Text, countFirstLetter))
' если параграф начинается с символов, которые можно преобразовать в число
' (если этого недостаточно - можно создать функцию проверки на валидность значения времени, внедрив его в функцию IsDate)
If IsNumeric(Replace(arrContent(1), delimChar, "")) Then

' выясняем - имеется ли уже значение строки в словате
If dicParagraphsContents.Exists(arrCon tent(0)) Then
' если ключ имеется - дописываем время
dicParagraphsContents.Item(arrConte nt(0)) = dicParagraphsContents.Item(arrConte nt(0)) & ", " & arrContent(1)
Else
' если ключа нет - просто добавляем строку
dicParagraphsContents.Item(arrConte nt(0)) = arrContent(1)
End If

End If
End If
' -> здесь можно удалить содержание параграфа
Next

End If
End With
Else ' окончание обычной формальности
MsgBox "Отсутствует активный документ", 48
Exit Sub
End If

' ШАГ 2 - передаем созданные значения в массив и сортируем его по значениям времени
' инициализируем массив необходимого размера (словаря)
ReDim arrNewParagraphs(2, dicParagraphsContents.Count)

' передали в массив данные из словаря
' PS в этом месте так же можно добавить любое форматирование, например заменить скобки на кавычки или...
For i = 0 To UBound(arrNewParagraphs, 2) - 1
arrNewParagraphs(1, i) = dicParagraphsContents.Keys()(i) ' это водержание
arrNewParagraphs(0, i) = dicParagraphsContents.Item(arrNewPa ragraphs(1, i)) ' это время (перечисление)
Next

' сортируем массив (сокращаю постинг - длинный)
' ШАГ 3 - передаем параграфы из массива в документ
With ActiveDocument.Paragraphs ' возвращаем коллекцию параграфов активного документа
For i = 0 To UBound(arrNewParagraphs, 2) - 1
.Add
.Item(.Count).Range.Text = arrNewParagraphs(0, i) & " " & arrNewParagraphs(1, i)
Next
End With

End Sub
-

Я его тестировал на весьма примитивном документе - 5 строк, так что ...
Можно макрос применить, как функцию более большой программы, передав в него кусок коллекции параграфов.

Ну хорошо, а тогда вопрос, где можно прочитать, о том как создать коллекцию параграфов?

[foreytor]

Сообщение от Prince1991

Ну хорошо, а тогда вопрос, где можно прочитать, о том как создать коллекцию параграфов?

Твой документ - это и есть коллекция параграфов (понашенски - абзацев). У тебя это практически каждая строчка. Попробуй просто вставить листинг в макросы и обработать твое типичное расписание.

Я не смог сохранить все комментарии - постинг вышел не пределе разрешенных здесь 5000 знаков, поэтому спрашивай, что не понятно, я постараюсь все объяснить.

[Prince1991]

Хорошо, тогда позанимаюсь с твоим выложенным скриптом, спасибо за подсказку в смысле - параграф - абзац...
Потом отпищусь, если получится...

[Sasha_Smirnov]

Я немного усовершенствовал программу от foreytor.

В приложенном документе запуск по F6. Просмотр кода — по Alt-F11 (отличие только в интерфейсе; как вам?..).

[foreytor]

Сообщение от Prince1991

Хорошо, тогда позанимаюсь с твоим выложенным скриптом, спасибо за подсказку в смысле - параграф - абзац...
Потом отпищусь, если получится...

Забыл предупредить об одном возможном подводном камне при работе с параграфами в WORD. Если Ваше расписание составляется не вручную, а вводится копированием из другой программы через виндозовский буфер обмена, то этот кусок может получиться одним единственным абзацем, хотя визуально строк будет много. Это происходит из-за того, что WORD считает параграфом то, что находится между разделителями vbCrLF [Chr(13) & Chr(10)], а скопированная веб-страничка, например, даст только один из них.

В таком случае нужна будет предварительная обработка - превратить этот единственный параграф в массив функцией Split, например
ArrayStrings = Split(ActiveDocument.Paragraphs(1). Text, vbCr)
и потом уже вставить строки из массива в документ, или, по желанию, заменить весь параграф вот такой простой функцией преобразования этого массива
ActiveDocument.Paragraphs(1).Text = Join(ArrayStrings, vbCrLF)

Удачи!

To Sasha_Smirnov
"программа" - это звучит гордо!
Вообще-то это даже не макрос, а набросок. Вариант, который можно рассмотреть для решения проблемы.
Но, конечно, интерфейс ему обязательно будет нужен, тут я согласен на все 100% !