1 Тема от Kirill94

  • Kirill94
  • рядовой
  • Неактивен
  • Зарегистрирован: 31.10.2012
  • Сообщений: 1

Тема: Удалить строки, где имеются повторяющиеся символы

Добрый день.
Скажите, пожалуйста, как удалить из Word 2007 документа строки, где имеются буквы, которые на этой же строке повторяются.

Например:

ABCD
ACVB
ACFH
ARTY
AABG
ETYE
FFTT

Нужно удалить строки, AABG, ETYE, FFTT, т.к. там есть символы которые повторяются (только на строке, к другой строке отношения НЕ имеет).

Нужно это сделать автоматически, т.к. обрабатывать вручную 50 000 строк слишком долго и можно сделать ошибку.

Заранее спасибо.

P.S.: если есть другие программы, в которых это можно сделать, то я с радостью их загружу.

2 Ответ от Alex_Gur

  • Удалить строки, где имеются повторяющиеся символы
  • Alex_Gur
  • Модератор
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 28.07.2011
  • Сообщений: 2,758
  • Поблагодарили: 492

Re: Удалить строки, где имеются повторяющиеся символы

Проблематично! smile Боюсь, это не вполне относится к нашей компетенции. Ваша задача имеет отношение, скорее, к программам поиска и сортировки, чем к текстовому редактору.

> если есть другие программы, в которых это можно сделать, то я с радостью их загружу.
Обычно такую программу люди пишут самостоятельно (на Visual Basic или на C).

Предварительно нужно изучить различные методы поиска и выбрать из них наиболее эффективный.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

3 Ответ от Вождь

  • Удалить строки, где имеются повторяющиеся символы
  • Вождь
  • Модератор
  • Неактивен
  • Зарегистрирован: 07.01.2010
  • Сообщений: 745
  • Поблагодарили: 181
  • За сообщение: 1

Re: Удалить строки, где имеются повторяющиеся символы

Можно помучиться поиском и заменой, если плясать от шаблона "([A-Z])[A-Z]@\1", но макросом будет проще:

Public Sub Macro()

Dim R As Word.Range
Dim N As Long
Dim S As String

    ' готовим поиск
    Set R = ActiveDocument.Range(0, 0)
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = Word.wdFindStop
        .MatchWildcards = True
    End With
    N = 0
    S = ""
    
    StatusBar = "Поиск..."
    Application.ScreenUpdating = False
    
    ' две одинаковые буквы подряд
    R.Find.Text = "([A-Z])\1"
    GoSub sub_Find
    
    ' одинаковые буквы через другие
    R.Find.Text = "([A-Z])[A-Z]@\1"
    GoSub sub_Find
    
    S = "Операция успешно завершена."
1:
    Application.ScreenUpdating = True
    S = S & VBA.vbLf & VBA.vbLf
    S = S & "Удалено абзацев: " & CStr(N)
    StatusBar = ""
    MsgBox Prompt:=S
    Exit Sub
    
sub_Find:

    R.SetRange Start:=0, End:=0
    Do
        R.Find.Execute
        If R.Find.Found <> True Then Exit Do
        R.Expand Unit:=Word.wdParagraph
        On Error Resume Next
        R.Delete
        If Err.Number <> 0 Then
            S = "Поиск прерван из-зи ошибки!"
            GoTo 1 ' ошибка
        End If
        N = N + 1
    Loop
    Return
    
End Sub
Макросы под заказ и готовый пакет - mtdmacro.ru

СайтВождь