Загрузка данных


Sub Button_Increment_Years()
    Dim cell As Range
    Dim regEx As Object, matches As Object, m As Object
    Dim text As String, curYear As String, newYear As String
    Dim startPos As Integer, offset As Integer
    
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "\b\d{4}\b" ' Ищет 4-значные числа (годы)
    regEx.Global = True
    
    Application.ScreenUpdating = False ' Отключаем мерцание экрана для скорости
    
    ' Перебираем все заполненные ячейки в столбце А (начиная со 2-й строки)
    For Each cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
        text = cell.Value
        If regEx.Test(text) Then
            Set matches = regEx.Execute(text)
            offset = 0
            For Each m In matches
                curYear = m.Value
                newYear = CStr(Val(curYear) + 1)
                startPos = m.FirstIndex + 1 + offset
                text = Left(text, startPos - 1) & newYear & Mid(text, startPos + Len(curYear))
                offset = offset + (Len(newYear) - Len(curYear))
            Next m
            cell.Value = text ' Записываем обновленный текст обратно
        End If
    Next cell
    
    Application.ScreenUpdating = True
    MsgBox "Годы успешно увеличены во всем столбце!", vbInformation, "Готово"
End Sub