Выделение цветом абзацов с одинаковыми числовыми значениями в тексте в Word'e

[xamillion]

В общем имеется огромный список предприятий и краткая их характеристика... необходимо выделить цветом те абзацы в которых имеются одинаковые их коды (числовые значения) для визуального обнаружения повторного ввода... ну что-то на типа условного форматирования в Excel'e...

Заранее спасибо за помощь...

Пример ниже во вложении...

[Sasha_Smirnov]

А не лучше ли просто эти абзацы отсортировать?

[xamillion]

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

А не лучше ли просто эти абзацы отсортировать?

Текст неоднообразный, непоследовательный. Единственное что соблюдается так это один абзац на предприятие...

[Sasha_Smirnov]

Так вот я и пишу, увидев, что каждый код — в своём абзаце.

В 97-м ворде (в виде Структура) есть команда Сортировать абзацы, и она прекрасно работает.

А вот в 2007-м что-то не нахожу такую. Сортировка абзацев:

Sub Макрос1()
Selection.Sort
End Sub

А в принципе я вашу задачу решил: вставил в Excel, затем: меню Данные, а в нём сортировка.

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

Еще раз повторюсь - текст неоднообразный и непоследовательный (пример упростил), да и абзацев уж очень много для визуального сравнения. Сортировка тут не поможет...

А когда вы таки раскрасите те 400 строк (макросом Алекса), то что же — будете их выискивать перемоткой туда-сюда?

Допустим, что повторы нужно удалить. И когда они идут подряд — это удобно.

(Кстати, в следующей теме речь как раз об удалении повторов.)

Я вообще-то имел в виду сортировку по кодам, а не по алфавиту. Просто здесь это случайно совпало.

[viter.alex]

Выдели число, абзац с которым нужно найти, и запусти макрос

Sub HighlightPars()
  Dim sNumber As String
  
  sNumber = Selection.Text
  With ActiveDocument.Range.Find
    .Text = sNumber
    While .Execute
      .Parent.Paragraphs.Last.Range.HighlightColorIndex = wdYellow
    Wend
  End With
  
End Sub

Sasha_Smirnov, а вторая кнопка в правом верхнем углу группы «Абзац» на вкладке «Главная» не то же самое делает?
Вот эта:

[xamillion]

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

Так вот я и пишу, увидев, что каждый код — в своём абзаце.

В 97-м ворде (в виде Структура) есть команда Сортировать абзацы, и она прекрасно работает.
...
А в принципе я вашу задачу решил: вставил в Excel, затем: меню Данные, а в нём сортировка ... .

Еще раз повторюсь - текст неоднообразный и непоследовательный (пример упростил), да и абзацев уж очень много для визуального сравнения. Сортировка тут не поможет...

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

Выдели число, абзац с которым нужно найти, и запусти макроc...

Да если бы все так просто было бы, я бы эти 4 000 предприятий вручную через Ctr+F нашел бы...

Нужно чтобы подсветились все абзацы где всречаются повторяющиеся коды без моего вмешательства (одним цветом хорошо, разными вообще прекрасно)...

[viter.alex]

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

…Нужно чтобы подсветились все абзацы где всречаются повторяющиеся коды без моего вмешательства (одним цветом хорошо, разными вообще прекрасно)...

Не знаю, зачем это нужно, но это совсем не сложно. Зачем выделять-то?

Sub HighlightPars()

  Dim iStart As Long 'Верхняя граница диапазона поиска
  Dim oCurrDoc As Document 'Рабочий документ
  Dim nColor As Long 'Цвет выделения
  Dim sNumber As String 'Искомое число
  
  Set oCurrDoc = ActiveDocument
  With oCurrDoc.Range(iStart, oCurrDoc.Range.End).Find
    .Text = "[0-9]{8}" 'Ищем любое число из восьми цифр
    .MatchWildcards = True 'Подстановочные знаки
    .Font.Shading.BackgroundPatternColor = wdColorAutomatic 'Без заливки
    While .Execute
      .Parent.Select
      iStart = .Parent.End 'Конец найденного слова
      nColor = GetRandomColor 'Получаем случайный цвет
      sNumber = .Parent.Text 'Найденный текст
      'Закрашиваем абзац, в котором нашли номер
      .Parent.Paragraphs.First.Range.Font.Shading.BackgroundPatternColor = nColor
      'Запускаем еще один поиск, но уже с конкретным числом
      With oCurrDoc.Range(iStart, oCurrDoc.Range.End).Find
        .Text = sNumber
        While .Execute
          .Parent.Paragraphs.First.Range.Font.Shading.BackgroundPatternColor = nColor
        Wend
      End With
    Wend
  End With
End Sub

Function GetRandomColor() As Long
  Randomize
  Dim R As Byte
  Dim G As Byte
  Dim B As Byte
  
  R = Int(255 * Rnd) + 1
  G = Int(255 * Rnd) + 1
  B = Int(255 * Rnd) + 1
  
  GetRandomColor = RGB(R, G, B)
End Function

[xamillion]

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

Не знаю, зачем это нужно, но это совсем не сложно. Зачем выделять-то?

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

ну выделять все подряд не надо... "закоментировал строку" ниже...

Sub HighlightPars()
...
    'Закрашиваем абзац, в котором нашли номер
    '.Parent.Paragraphs.First.Range.Font.Shading.BackgroundPatternColor = nColor
    'Запускаем еще один поиск, но уже с конкретным числом
...

числа теперь ищем с 7 цифр т.к. они не закрашивались - "ОБЩЕСТВО С ОГРАНИЧЕННОЙ ОТВЕТСТВЕННОСТЬЮ "НОВЬ",3726157", например...

но при этом выделяются все дубликаты кроме первых... можно как то это исправить?

[viter.alex]

Я не пойму, чего нужно добиться. Если ты закомментировал эту строку, то первый абзац, в котором было найдено число закрашиваться не будет. Если строку поиска [0-9]{8} заменить на [0-9]{7;8}, то искать будет и семизначные, и восьмизначные номера
Может дубликаты нужно просто удалить?

[xamillion]

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

Я не пойму, чего нужно добиться. Если ты закомментировал эту строку, то первый абзац, в котором было найдено число закрашиваться не будет. Если строку поиска [0-9]{8} заменить на [0-9]{7;8}, то искать будет и семизначные, и восьмизначные номера
Может дубликаты нужно просто удалить?

Если не закомментировать эту строку то выделяется все подряд!!! а нужно выделять только те абзацы где есть один и тот же код предприятия... встретился код один раз - абзац не выделяем, встретился два - выделяем оба, если больше - выделяем столько сколько одинаковых кодов.

[0-9]{7;8} - именно так и сделал...