Макрос для word

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
КИС
Сообщения: 5
Зарегистрирован: 10 сен 2010, 14:41

Добрый день, уважемые форумчане...
Вообщем такая проблема, не могли бы подсказать, как правильно написать скрипт на 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 "УНИВЕР". Ситком.

Все обыскал, не могу решить...
Помогите решить, может кто нибудь натыкался, дайте ссылку, если есть.
Аватара пользователя
EducatedFool
Сообщения: 197
Зарегистрирован: 06 апр 2008, 14:03
Откуда: Россия, Урал
Контактная информация:

Если бы исходный текст был не в Word, а в Excel - все можно было бы сделать одной функцией: http://excelvba.ru/code/JoinedArray
Макросы для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. http://ExcelVBA.ru/

Благодарности принимаются на кошелёк WebMoney: R318574877619 и Яндекс.Деньги: 41001335672216
КИС
Сообщения: 5
Зарегистрирован: 10 сен 2010, 14:41

Да нет, в том то и дело, что нужно для word, а про excel я знаю...
Аватара пользователя
AlexEL
Сообщения: 24
Зарегистрирован: 23 авг 2008, 06:44
Контактная информация:

Попробуй так:

Код: Выделить всё

Public Sub Программа()
    ' сортируем по названиям
    ActiveDocument.Range.Sort _
        ExcludeHeader:=False, _
        FieldNumber:=2, _
        SortFieldType:=Word.wdSortFieldStroke, _
        SortOrder:=Word.wdSortOrderAscending, _
        FieldNumber2:=1, _
        SortFieldType2:=Word.wdSortFieldStroke, _
        SortOrder2:=Word.wdSortOrderAscending, _
        CaseSensitive:=True, _
        Separator:=" "
    ' удаляем дубликаты названий
    With ActiveDocument.Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = True
        .Wrap = wdFindContinue
        .Text = "([0-9., ]@)( ""[!^13]@^13)([0-9., ]@)(\2)"
        .Replacement.Text = "\1, \3\4"
        While .Execute(Replace:=Word.wdReplaceAll): Wend
    End With
    ' сортируем по времени
    ActiveDocument.Range.Sort _
        ExcludeHeader:=False, _
        FieldNumber:=1, _
        SortFieldType:=Word.wdSortFieldNumeric, _
        SortOrder:=Word.wdSortOrderAscending, _
        FieldNumber2:=2, _
        SortFieldType2:=Word.wdSortFieldNumeric, _
        SortOrder2:=Word.wdSortOrderAscending, _
        Separator:="."
End Sub
Макросы под заказ и готовый пакет: http://methodichka.ru/
КИС
Сообщения: 5
Зарегистрирован: 10 сен 2010, 14:41

Хорошо, щас проверю...
Аватара пользователя
Busine2009
Сообщения: 322
Зарегистрирован: 18 июл 2009, 15:34
Контактная информация:

КИС
только Ситком встречается? В остальном меняется только время и название передач?
Т. е. одинаковые названия передач надо объединять?
Сколько дней находится в одном документе? Нужен макрос, который сразу все дни обработает или можно выделять день и его обрабатывать, а затем к следующему переходить? Если несколько дней, то какие они имею заголовки (что написано, например, понедельник).
Чтобы много не писать, лучше вставь образец файла.
КИС
Сообщения: 5
Зарегистрирован: 10 сен 2010, 14:41

Ну вообщем каналов много, и обрабатывать нужно все дни, соответственно названия каналов не меняется практически, меняется только время, одинаковые нужно объединить, хотел бы запускать макрос после выделения к примеру понедельника, потом вторник, потом прогонять по среду, ну так и далее... Ладно вечером в понедельник, или во вторник выложу образец, и оригинал и обработанный (правда эти моменты, ну эти объединения еще не автоматизаровал), поэтому делаем в ручную, а это практически потеря 6 часов... Пока еще копаюсь VBA целыми днями, пытаюсь облегчить труд себе, возможно еще кому нибудь пригодяться...
Аватара пользователя
EducatedFool
Сообщения: 197
Зарегистрирован: 06 апр 2008, 14:03
Откуда: Россия, Урал
Контактная информация:

Посмотрите макрос во вложении в этом сообщении: http://www.programmersforum.ru/showpost ... stcount=11
Там есть что-то связанное с обработкой телепрограмм.
Макросы для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. http://ExcelVBA.ru/

Благодарности принимаются на кошелёк WebMoney: R318574877619 и Яндекс.Деньги: 41001335672216
КИС
Сообщения: 5
Зарегистрирован: 10 сен 2010, 14:41

Спасибо большое, к этому я присматривался...
Ответить