чтобы постоянно не править руками этот параметр,
Введите вычисление последней заполненной строки iLastRow
Sub MakeBold_1()
Dim temp As Object
Dim iCell As Range, iPos&
Dim FirstPart As String
Dim FI As Integer
Dim L As Integer
Dim amp As Integer
Dim iLastRow As Long
With CreateObject("VBScript.RegExp")
.Global = False
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & iLastRow).Font.Bold = False
For Each iCell In Range("A1:A" & iLastRow).SpecialCells(xlConstants, xlTextValues)
If iCell <> "" Then
.Pattern = "([A-ZА-ЯЁ][a-zа-яё]+)(-| )?([A-ZА-ЯЁ][a-zа-яё]+)?, ?[A-ZА-ЯЁ]\. ?([A-ZА-ЯЁ]\.)?"
FirstPart = Split(iCell, "/")(0)
If .test(FirstPart) Then
Set temp = .Execute(FirstPart)
FI = temp(0).FirstIndex
L = temp(0).Length
iCell.Characters(FI + 1, L - 1).Font.Bold = True
Else
.Pattern = "@[А-ЯЁ]"
iPos = InStr(iCell.Value, "/")
If .test(FirstPart) Then
amp = .Execute(FirstPart)(0).FirstIndex
iCell.Characters(amp + 2, iPos - 3 - amp).Font.Bold = True
Else
iCell.Characters(1, iPos - 2).Font.Bold = True
End If
End If
End If
Next
End With
End Sub