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