Страницы: 1
RSS
VBA RegEx макрос для .docx (или для строки в ячейке Excel), Замена значений в тексте
 
Всем доброго времени суток. Прошу помощи в написании макроса.
Имеется огромный документ, в котором наименование источников необходимо привести к "ссылочному" варианту. Вручную перебирать более 1500 источников было бы крайне утомительно, да и задача время от времени возникает.

В документе .docx (хотя задача может быть решена и для текста в ячейке A1 в документе .xlsx) необходимо найти первый фрагмент, заключенный между служебными словами ref и заменить такой фрагмент во всем тексте на [1] и т.д.

Было: ref[ivanov-14]ref, тут текст ref[!VasilyevMA]ref еще текст [text], ref[ivanov-14]ref
Стало: [1], тут текст [2] еще текст [text], [1]

Другими словами, произвести замену элементов по всему тексту на порядковые номера, по порядку следования.

За основу можно взять скрипт источник ():
Код
Sub ReplaceText()
    Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.Text = ""
        Do While .Execute(FindText:="\[*\]", MatchWildcards:=True)
            .Execute FindText:="[[\] ]", MatchWildcards:=True, _
                ReplaceWith:="", Replace:=wdReplaceAll, Wrap:=wdFindStop
        Loop
    End With
    Application.ScreenUpdating = True
End Sub
Изменено: taxol - 29.11.2022 10:24:10
 
Задача решена практически на 99%, для этого пришлось все ссылки обрамить служебными словами:  ref[ссылка]ref,
однако зачастую программа "проскакивает" некоторые элементы и в результате нарушается порядок: [1], [2], [4], [5] ...
Не мог бы кто-нибудь подсказать, как пофиксить баг?
Код
Sub findTest()
    Application.ScreenUpdating = False
    Dim firstTerm As String
    Dim secondTerm As String
    Dim myRange As Range
    Dim documentText As String

    Dim startPos As Long 'Stores the starting position of firstTerm
    Dim stopPos As Long 'Stores the starting position of secondTerm based on first term's location
    Dim nextPosition As Long 'The next position to search for the firstTerm
    Application.ScreenUpdating = False
    nextPosition = 1
    'Get all the document text and store it in a variable.
    Set myRange = ActiveDocument.Range

    documentText = myRange.Text
    i = 1
    With Selection.Find
    
        Do While .Execute(FindText:="ref[")
            Selection.HomeKey Unit:=wdStory
    'First and Second terms as defined by your example.  Obviously, this will have to be more dynamic
    'if you want to parse more than justpatientFirstname.
            firstTerm = "ref["
            secondTerm = "]ref"
            
            startPos = InStr(nextPosition, documentText, firstTerm, vbTextCompare)
            stopPos = InStr(startPos, documentText, secondTerm, vbTextCompare)
            myString = Mid$(documentText, startPos + Len(firstTerm), stopPos - startPos - Len(firstTerm))
            myString2 = "ref[" & myString & "]ref"
            nextPosition = InStr(stopPos, documentText, firstTerm, vbTextCompare)

    
            myRange.Find.Execute FindText:=myString2, ReplaceWith:="[" & i & "]", Replace:=wdReplaceAll
     
            i = i + 1
        Loop
    End With
    Application.ScreenUpdating = True
        
End Sub
 
Код
Function RepRef$(s$)
  Dim re, ms, m, i&
  Set re = CreateObject("VBScript.RegExp")
  re.Global = True: re.MultiLine = True: re.Pattern = "ref\[[^]]+\]ref"
  If re.test(s) Then
    Set ms = re.Execute(s)
    For Each m In ms
      i = i + 1: s = Replace(s, m, "[" & i & "]")
    Next
  End If
  RepRef = s
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Большое спасибо за ответ! Дело в том, что как и в моем случае, возникает ошибка.
Получается [1],[2],[3],[7] вместо [1],[2],[3],[4]
Изменено: taxol - 02.12.2022 00:42:59
 
это не ошибка
это ОТСУТСВИЕ обьяснений задачи
где должно быть человеческим языком сказано что делать если в данных есть одинаковые ссылки
все что вы не обьяснили, но очень сильно об этом думали - осталось в ваших мыслях и ни одним словом не коснулось меня
исправляйте самостоятельно)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
это не ошибка
это ОТСУТСВИЕ обьяснений задачи
где должно быть человеческим языком сказано что делать если в данных есть одинаковые ссылки
все что вы не обьяснили, но очень сильно об этом думали - осталось в ваших мыслях и ни одним словом не коснулось меня
исправляйте самостоятельно)
Вот именно что предусмотрел, даже дважды в тексте отобразил.

Первый раз:

"необходимо найти первый фрагмент, заключенный между служебными словами ref и заменить такой фрагмент во всем тексте на [1] и т.д."

Внимание вопрос (глядя на эту фразу), ссылка может встречаться в тексте более чем один раз?

А второй раз даже пример привел, если Вы вдруг не заметили, аккурат с "одинаковыми ссылками":

Было: ref[ivanov-14]ref, тут текст ref[!VasilyevMA]ref еще текст [text], ref[ivanov-14]ref
Стало: [1], тут текст [2] еще текст [text], [1]

Тем не менее, просто по человечески благодарю за проявленный интерес к проблеме.
Изменено: taxol - 02.12.2022 15:10:59
 
макрос во всем тексте одинаковые ссылки не заменил на одинаковые номера? (в т.ч. в примерах)
))
Код
If InStr(s, m) Then i = i + 1: s = Replace(s, m, "[" & i & "]")
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Да, я не мог понять, что Replace не производит замену в исходном, анализируемом тексте "documentText", а стало быть, натыкается в последующем на ранее найденные ref[*]ref и проводит итерацию i = i +1 но без преобразования значения. Это я смог понять после Вашего поста о "одинаковых ссылках". Уже думал создавать массив с "ранее встречавшимися" ссылками, с последующей проверкой.
Да, это решает проблему, вопрос закрыт:
Цитата
написал:
1If InStr(s, m) Then i = i + 1: s = Replace(s, m, "[" & i & "]")
Еще раз, огромное человеческое спасибо, Вы очень и очень выручили!!!!
 
А может так ?
Код
Option Explicit

Sub abcdf()
    Dim i As Long, fnd As String, rplc As String, txtrng As Object
    
    Selection.HomeKey Unit:=wdStory
    
    Set txtrng = ActiveDocument.Range
    txtrng.Find.ClearFormatting
    txtrng.Find.Replacement.ClearFormatting
    
    Do While txtrng.Find.Execute(FindText:="ref\[*\]ref", MatchWildcards:=True)
        i = i + 1
        rplc = "[" & i & "]"
        fnd = ActiveDocument.Range(Start:=txtrng.Start, End:=txtrng.End).Text
        txtrng.Find.Execute FindText:=fnd, MatchWholeWord:=True, MatchWildcards:=False, _
                        Forward:=True, Wrap:=wdFindContinue, ReplaceWith:=rplc, _
                        Replace:=wdReplaceAll
    Loop
End Sub
Страницы: 1
Наверх