1

Тема: Макрос на поиск и замену DDMMM при условии

Умные и добрые люди, прошу подсказать каким макросом (если вообще возможно) можно заставить Word найти любую дату в формате ddMMM, а затем при условии, что в конце предложения будет текст +1, +2, либо -1, -2 заставить эту дату перенестись в конец строки с прибавлением/вычитанием дня/дней.

Вот пример текста:

05АВГ .......текст текст текст +1
08СЕН.......текст текст текст +2

(это всё одна строка),

а нужен следующий результат:

05АВГ .......текст текст текст 06АВГ
08СЕН .......текст текст текст 10СЕН и т.д.

Или здесь без массивов уже не обойтись? Не догоняю... Буду крайне признателен!  roll

2

Re: Макрос на поиск и замену DDMMM при условии

Вот нашел что-то на форуме, что умеет прибавлять 1 день... но как же это применить

Visual Basic
Выделить код

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

   

Sub sequence_dates()
' Макрос получения последовательности дат
    Dim myRange As Range  ' объявляем переменные.
    Dim FirstDate As Date
    Dim IntervalType As String '    "yyyy" Год, "q" Квартал, "m" Месяц,
'                                    "y" День года, "d" День, "w" День недели "ww" Неделя
    Dim Number As Integer
    IntervalType = "d"
    Number = 1          ' Приращение даты (1 день)
    Set myRange = ActiveDocument.Content
    myRange.Find.Execute FindText:="[0-9]{2}.[0-9]{2}.[0-9]{4}", Forward:=True, MatchWildcards:=True
    If myRange.Find.Found = True Then
        FirstDate = myRange.Text '
        myRange.Collapse Direction:=wdCollapseEnd
    Else
    MsgBox "В документе отсутствуют даты для обработки"
    Exit Sub
    End If
'После того, как получили значение начальной даты, в цикле изменяем значения остальных дат
    Do
        myRange.Find.Execute FindText:="[0-9]{2}.[0-9]{2}.[0-9]{4}", Forward:=True, MatchWildcards:=True
        If myRange.Find.Found = True Then
            myRange.Text = DateAdd(IntervalType, Number, FirstDate)
            Number = Number + 1
'            Debug.Print (Number & vbTab & myRange.Text)
            myRange.Collapse Direction:=wdCollapseEnd
        Else: Exit Do
        End If
    Loop
End Sub