Приват - клик по "человечку" слева от ника форумчанина. Паблик- стереть двоеточие (или символ @) ника юзера. Нарушения Правил Форума в чате запрещены. Есть тема "Политика. Новости, статьи, обсуждения " в разделе "Не политические Новости" - политику обсуждаем там.

Автор Тема: Как Найти И Выделить Дубликаты Абзацев/Предложений В Документе Word?  (Прочитано 203 раз)

Оффлайн Chitatel

  • Сам живи и другим давай)
  • Поручик
  • *

+Info

  • Репутация: 52
  • Сообщений: 387
  • Activity:
    23.5%
  • Благодарностей: +685
  • Пол: Мужской
You are not allowed to view links. Register or Login
  • Доработанный макрос
работает дольше (вырезал 4 главы) = результат подобен Макросу - SearchForReps...


Золотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого Легиона

Онлайн lwa

  • Старшина
  • *

+Info

  • Репутация: 14
  • Сообщений: 55
  • Activity:
    11.5%
  • Благодарностей: +168
  • Пол: Мужской
Ещё вариант.
Сравнивает не весь абзац на совпадение, а заданное количество символов от начала абзаца, включая пробелы. Абзацы меньше заданного размера, игнорируются. По времени выполнения также ~ 4 мин.
Единственно цветом выделяется по прежнему весь абзац.
You are not allowed to view links. Register or Login
' Поиск повторяющихся фпагментов абзацев
Sub SearchForReps2()
    Dim N_simbol As Single, InData As String

    InData = InputBox("Введите минимальное количество совпадающих символов для поиска", Title)
    If InData <> "" Then
        N_simbol = CSng(InData)
    Else
        N_simbol = 0
        MsgBox "Вы отказались от ввода данных!"
    End If
   
    If N_simbol > 0 Then
        With ActiveDocument
            Dim i, j, Para_count As Long
            Para_count = ActiveDocument.Paragraphs.count
            ReDim colorTxt(1 To Para_count)
            ReDim sizeTxt(1 To Para_count) As Long
            ReDim aBuf(1 To Para_count) As String
   
            For i = 1 To Para_count
                DoEvents
                aBuf(i) = Left(StrConv(.Paragraphs(i).Range.Text, vbFromUnicode), N_simbol)
                sizeTxt(i) = Len(aBuf(i))
                colorTxt(i) = wdWait
            Next i
       
            Options.DefaultHighlightColorIndex = wdYellow
            Application.ScreenUpdating = False
       
            ' Поиск одинаковых абзацев
            For i = 1 To Para_count - 1
                If sizeTxt(i) = N_simbol Then
                    If colorTxt(i) <> wdYellow Then
                        For j = i + 1 To Para_count
                            DoEvents
                            If sizeTxt(j) = N_simbol Then
                                If StrComp(aBuf(i), aBuf(j), 0) = 0 Then
                                    .Paragraphs(i).Range.HighlightColorIndex = wdBrightGreen
                                    .Paragraphs(j).Range.HighlightColorIndex = wdYellow
                                    colorTxt(j) = wdYellow
                                End If
                            End If
                        Next j
                    End If
                 End If
            Next i
        End With
       
        MsgBox "Процесс поиска завершен."
    End If
End Sub


Золотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого Легиона

Оффлайн Chitatel

  • Сам живи и другим давай)
  • Поручик
  • *

+Info

  • Репутация: 52
  • Сообщений: 387
  • Activity:
    23.5%
  • Благодарностей: +685
  • Пол: Мужской
Размер абзацев будет одинаков.
Ведь что по сути происходит..
При копировании фрагментов текста в общий файл иногда попадают два одинаковых абзаца/отрезка текста.
Так происходит, если один и тот же абзац/отрезок был в конце первого фрагмента, а потом второй фрагмент начат с этого абзаца. Они будут стоять сразу друг за другом = подряд.
Вот это и нужно обнаружить для удаления повтора.
Пока находятся повторы слов, но в тексте такое может быть и есть. А нужные блоки повторов не находит.


Золотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого Легиона

Онлайн lwa

  • Старшина
  • *

+Info

  • Репутация: 14
  • Сообщений: 55
  • Activity:
    11.5%
  • Благодарностей: +168
  • Пол: Мужской
Если в документе в котором ты выложил есть такой повтор, укажи на какой странице. Может что и придумаю.
К стати в ГКР4.docx, с помощью SearchForReps2 и поиском по 20-ти символам, нашелся повтор на стр 63. Абзац начинается "Добавил в корреспонденты Бома и отправил ...."


Золотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого Легиона

Оффлайн Chitatel

  • Сам живи и другим давай)
  • Поручик
  • *

+Info

  • Репутация: 52
  • Сообщений: 387
  • Activity:
    23.5%
  • Благодарностей: +685
  • Пол: Мужской
You are not allowed to view links. Register or Login
Если в документе в котором ты выложил есть такой повтор, укажи на какой странице. Может что и придумаю.
К стати в ГКР4.docx, с помощью SearchForReps2 и поиском по 20-ти символам, нашелся повтор на стр 63. Абзац начинается "Добавил в корреспонденты Бома и отправил ...."
Это как раз и есть тот самый повтор...  spr
Я книгу слушал в читалке, уловить повтор уловил, но точно его не запомнил...
Заказ числа знаков - отличное решение.

Если возможно  :friends2:, было бы отлично:
- добавить некий прогресс-бар выполнения задачи, диспетчер задач не показывает динамики, да и понимать (хотя бы примерно) затраты времени на задачу = было бы отлично.

Если такое удастся - будет инструмент, который можно рекомендовать для работы с тестом всем кто занимается этим на форуме.  spr

P.S. Прогнал скрипт SearchForReps2 по всей книге, скрипт справился минуты за 4-5 = это нормальный результат.
Повтор найден и отмечен.  spr
Как по мне - уже сейчас это работоспособный скрипт. Я им буду пользоваться.
Спасибо.

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

Готов дооформить эту тему, внести пояснения как и чем пользоваться, указать тебя как автора/соавтора  (не знаю что тебе приемлемо) не со мной, а с тем человеком кто сделал первый скрипт на который я ссылался.
Как по мне = скрипт тобой переработан капитально  pivo


Золотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого Легиона

Онлайн lwa

  • Старшина
  • *

+Info

  • Репутация: 14
  • Сообщений: 55
  • Activity:
    11.5%
  • Благодарностей: +168
  • Пол: Мужской
Ускорить не получилось, не достаточно знаний команд VBA. Возможно есть методы и способы позволяющие выполнять поиск быстрее.

Нашел пример, как добавить вывод прогресса. В итоге из-за него макрос стал в 1,5 раза медленнее.

Выкладываю документ с набором макросов и кратким описанием. Документ подготовлен в старом формате doc. Сейчас проще перенести в него весь проверяемый текст, чем объяснить что и куда перенести для работы макроса в новом документе.

You are not allowed to view links. Register or Login
Можешь сделать сам, могу я сделать.
Если имеющееся в документе описание не полное, предлагаю тебе его дополнить и потом распространять. Кроме этого, при желании,  документ можно будет пересохранить в более современном формате (docx, docm).


Золотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого Легиона

Оффлайн Chitatel

  • Сам живи и другим давай)
  • Поручик
  • *

+Info

  • Репутация: 52
  • Сообщений: 387
  • Activity:
    23.5%
  • Благодарностей: +685
  • Пол: Мужской
 На мой взгляд такой информации достаточно для принятия решения теми кто посетит тему - пользоваться тем что есть или нет, а так же описано как это работает.

Под мою задачу подошёл - SearchForReps2.
Им я намерен пользоваться и в дальнейшем.
Спасибо тебе  :friends2: за отзывчивость и труд.

You are not allowed to view links. Register or Login
Выкладываю документ с набором макросов и кратким описанием. Документ подготовлен в старом формате doc. Сейчас проще перенести в него весь проверяемый текст, чем объяснить что и куда перенести для работы макроса в новом документе.


You are not allowed to view links. Register or Login
Цитата: Search.doc (53.5 КБ )
Здесь добавлены макросы:

highligh7tdup – найденный в интернете пример поиска полностью одинаковых абзацев. Первый из найденных одинаковых абзацев выделяется зеленным цветом, остальные желтым. (Источник: You are not allowed to view links. Register or Login)

SearchForReps1 - переделанный highligh7tdup. Попытка ускорить выполнение макроса.

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

SearchForReps4 -  выполняет поиск двух соседних абзацев отвечающим условию – если заданной длины (в символах) фрагмент от начала абзаца присутствует в предыдущем абзаце, оба абзаца выделяются зеленным цветом.

Работа макросов SearchForReps1, SearchForReps2, SearchForReps4 разбита на два этапа:
1. подготовка данных
2. поиск условий, отвечающим требованиям

Прервать выполнение макросов можно закрытием Формы отображающий прогресс выполнения работы.

« Последнее редактирование: 01-03-2019, 20:55 от Chitatel »


Золотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого ЛегионаЗолотой орден Орла Девятого Легиона

 

Похожие темы

  Тема / Автор Ответов Последний ответ
8 Ответов
5051 Просмотров
Последний ответ 19-01-2018, 20:00
от Старый Бука
10 Ответов
7066 Просмотров
Последний ответ 07-02-2017, 20:03
от ag517
3 Ответов
2666 Просмотров
Последний ответ 28-12-2007, 05:53
от poling
0 Ответов
637 Просмотров
Последний ответ 13-07-2013, 13:46
от Diktator
5 Ответов
708 Просмотров
Последний ответ 21-08-2017, 20:02
от Алексий

Напоминаем, для того чтобы отслеживать изменения тем на форуме нужен валидный (работающий) е-майл в Вашем профиле + подписка на тему из свойств меню темы (Уведомлять -вкл.). НЕ рекомендуем пользоваться ящиками на Mail.ru (часто письмо просто не приходит). В случае попадания (проверяем) писем с форума в папку СПАМ (этим грешат некоторые сервисы) указываем майл клиенту или сервису - НЕ спам.