1 Тема от MarG

  • MarG
  • рядовой
  • Неактивен
  • Зарегистрирован: 17.02.2011
  • Сообщений: 8

Тема: макрос для удалений ответов в тесте

Всем привет! Буду очень благодарен, если кто подскажет макрос, который удаляются неправильные ответы. Ну, мои цель это написать шпоры). Изначально тест создан из макроса test, вот например, в тесте указанно
##Test#НомерВопроса#СложностьВопроса#
##Q#
ТекстВопроса
##Q#
##A-#
ТекстОтвета1
##A#
##A+#
ТекстПравильногоОтвета2
##A#
##A-#
ТекстОтвета3
##A#
##A-#
ТекстОтвета4
##A#
##A-#
ТекстОтвета5
##A#

Post's attachments

test.dot 61.5 Кб, 6 скачиваний с 2011-02-18 

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

2 Ответ от MarG

  • MarG
  • рядовой
  • Неактивен
  • Зарегистрирован: 17.02.2011
  • Сообщений: 8

Re: макрос для удалений ответов в тесте

тесты очень много, я вложил часть теста для примера

Post's attachments

матзадача.doc 69.5 Кб, 4 скачиваний с 2011-02-18 

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

3 Ответ от VBA-addict

  • VBA-addict
  • майор
  • Неактивен
  • Зарегистрирован: 12.10.2010
  • Сообщений: 66

Re: макрос для удалений ответов в тесте

Все ж банально - нужно просто убить все между "##A-# и ##A#"
делаем
1) банальный поиск по (##A-#)(*)(##A#) и замену по ним на пустоту - при включ галке Подстановочные знаки
2) "^0013{2;}" замена на "^0013" - это убить двойные и более пустые абзацы - при включ галке Подстановочные знаки

и макрос нафиг, но если хочется:
код

Sub RemoveWrongInfo()

    With ActiveDocument.Content.Find
        .Text = "(##A-#)(*)(##A#)"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = True
        .MatchWildcards = True

        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
    End With

    With ActiveDocument.Content.Find
        .Text = "^0013{2;}"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True

        .Replacement.Text = "^0013"
        .Execute Replace:=wdReplaceAll
    End With

End Sub

Отредактировано VBA-addict (18.02.2011 03:58:49)

Делай, что можешь, и будь, что будет!

4 Ответ от MarG

  • MarG
  • рядовой
  • Неактивен
  • Зарегистрирован: 17.02.2011
  • Сообщений: 8

Re: макрос для удалений ответов в тесте

VBA-addict, большое спасибо! Все получился. Сохранил кучу времени
Хотел еще спросить, получил результаты виде
##Test#НомерВопроса#СложностьВопроса#
##Q#
ТекстВопроса
##Q#
##A+#
ТекстПравильногоОтвета2
##A#

Можно ли дальше автоматизировать? Между ##Q# вопросы были бы полужирными и ##Q#, а также ##A+# удалялся, а между вопросом и ответом было б пробел
Ну, например чтоб конечном счете было бы так:
##Test#НомерВопроса#СложностьВопроса#
ТекстВопроса ТекстПравильногоОтвета2

5 Ответ от VBA-addict

  • VBA-addict
  • майор
  • Неактивен
  • Зарегистрирован: 12.10.2010
  • Сообщений: 66

Re: макрос для удалений ответов в тесте

добавь 2 блока в конец вышеприведенного макроса
вообще - все это можно и ручками smile через поиск и замену smile .Text -> .Replacement.Text + специальные параметры замены по шрифту типа жирный/нежирный

    With ActiveDocument.Content.Find
        .Text = "(^0013##Q#)(*)(##Q#^0013)"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = True
        .MatchWildcards = True

        .Replacement.Text = "\2"
        .Replacement.Font.Bold = True
        .Execute Replace:=wdReplaceAll
    End With
    
    With ActiveDocument.Content.Find
        .Text = "(^0013##A+#^0013)(*)(##A#^0013)"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = True
        .MatchWildcards = True

        .Replacement.Text = " \2"
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
Делай, что можешь, и будь, что будет!

6 Ответ от VBA-addict

  • VBA-addict
  • майор
  • Неактивен
  • Зарегистрирован: 12.10.2010
  • Сообщений: 66

Re: макрос для удалений ответов в тесте

Ну а если уж совсем хочется элегантно - добавь еще блок

    With ActiveDocument.Content.Find
        .Text = "(##Test#)([0-9]@)(#)([0-9]@)(#^0013)"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = True
        .MatchWildcards = True

        .Replacement.Text = "\2.\4 "
        .Execute Replace:=wdReplaceAll
    End With

Получишь:
НомерВопроса.СложностьВопроса ТекстВопроса ТекстПравильногоОтвета2

Делай, что можешь, и будь, что будет!

7 Ответ от MarG

  • MarG
  • рядовой
  • Неактивен
  • Зарегистрирован: 17.02.2011
  • Сообщений: 8

Re: макрос для удалений ответов в тесте

ура, все вышло!!!
VBA-addict, еще раз большое спасибо! Respect smile