Статьи из блога

Статьи из блога

Поиск слов и сохранение их в отдельном документе

Рубрика: Вопрос-Ответ, Макросы
Метки: |
Среда, 19 августа 2009 г.
Просмотров: 7813
Подписаться на комментарии по RSS
Версия для печати

[Ссылки на статью]

Валерий спрашивает:

Как из текста в Word 2007 выбрать все слова на определенную букву, расположить их в алфавитном порядке и сохранить их в отдельном файле?

Валерий, вот пример макроса для ваших целей, подсказанный Александром Витером.

Sub startWordsChar2()
'Поиск слов, начинающихся с определенной буквы и перенос их в
'отсортированный по алфавиту список в новый документ
Dim bukva As String
Dim newDoc As Document
Dim actDoc As Document
Dim oPar As Paragraph
Dim rng As Range
Set actDoc = ActiveDocument
Set rng = actDoc.Range
Do
  bukva = InputBox("Введите начальную букву слова в поле:", "Поиск слов")
  If StrPtr(bukva) = 0 Then
     Exit Sub
  ElseIf Len(bukva) = 0 Then
     MsgBox "Введите пожалуйста начальную букву " & vbCr & "или нажмите кнопку 'Cancel"
  End If
Loop Until Len(bukva) <> 0
Application.ScreenUpdating = False
Set newDoc = Documents.Add
'Ищем слово, начинающееся с указанной буквы в любом регистре
With actDoc.Range.Find
  .Text = "<[" & StrConv(bukva & bukva, vbProperCase) & "][А-Яа-яЁё]@>"
  .MatchWildcards = True
  While .Execute
    Application.StatusBar = "Добавляем " & bukva
    newDoc.Range.InsertAfter Trim(.Parent.Text)
    newDoc.Range.InsertParagraphAfter
  Wend
End With
'Сортируем содержимое нового документа
newDoc.Range.Sort , "Paragraphs", wdSortFieldAlphanumeric, wdSortOrderAscending
'Удаляем первый пустой абзац
newDoc.Paragraphs(1).Range.Delete
'Поскольку в каждом абзаце находится по одному слову, то нужно только перебирать абзацы и удалять _
все слова, которые содержатся в текущем
For Each oPar In newDoc.Paragraphs
  If oPar.Range.End <> newDoc.Range.End Then
    With newDoc.Range(oPar.Range.End, newDoc.Range.End).Find
      .Text = oPar.Range.Text
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub

Если вы не знаете, как подключить к документу и применить эти макросы, изучите следующие заметки с сайта:

Создание макроса из готового кода

Автоматическая запись макроса

twitter.com facebook.com vkontakte.ru odnoklassniki.ru mail.ru ya.ru rutvit.ru myspace.com technorati.com digg.com friendfeed.com pikabu.ru blogger.com liveinternet.ru livejournal.ru memori.ru google.com bobrdobr.ru mister-wong.ru yahoo.com yandex.ru del.icio.us

Еще записи по вопросам использования Microsoft Word:

Комментариев: 6

  1. Александр
    14.05.2010 в 11:45 | #1

    Здравствуйте! Простите, а как сделать, чтобы копировалось не слово в новый документ а строка содержащая это слово?

  2. 14.05.2010 в 15:04 | #2

    Строку или абзац?

    Если абзац, то нужно строку

    newDoc.Range.InsertAfter Trim(.Parent.Text)

    заменить на

    newDoc.Range.InsertAfter Trim(.Parent.Paragraphs.First.Range.Text)

  3. Александр
    18.05.2010 в 10:08 | #3

    Я же вроде написал - строку!

    И еще вопрос: будет ли работать макрас если мне, например, нужны не все слова на букву "а", а только те, которые начинаются на буквосочетание "ар"?

    И с цифрами не работает... :-(

  4. игорь
    25.06.2010 в 11:55 | #4

    а как сделать чтобы найти слова заклеюченные в ""

  5. 25.06.2010 в 13:15 | #5

    Чтобы можно было искать спецсимволы, перед ними нужно ставить обратную черту \

  6. Николай
    30.03.2012 в 16:58 | #6

    Добрый день!

    Подскажите, а если в документах есть единообразная двухмерная табличка. В первой колонке идет название значения, которое всегда единое, а в правой части значение. Мне надо взять значение одной строки, вставить ее в excel. Затем взять значение другой строки и вставить справа от первой. Такую операцию надо выполнить по 2000 документов, причем если вдруг такой таблицы не окажется, нужно просто пропустить документ. Как будет выглядеть скрипт?

Оставьте комментарий!

(обязательно)

^ Наверх