Sub TextChanger()
Dim i As Long
Const StrFind As String = "ALB,TRI,QIU,FSF"
    On Error Resume Next
    Application.ScreenUpdating = False
    For i = 0 To UBound(Split(StrFind, ","))
        With ActiveDocument.Range.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Format = True
            .Wrap = wdFindContinue
            .MatchWildcards = True
            .Text = "\@" & Split(StrFind, ",")(i) & " = (*^13)"
            .Replacement.Style = Split(StrFind, ",")(i)
            .Replacement.Text = "\1"
            .Execute Replace:=wdReplaceAll
        End With
    Next i
    Application.ScreenUpdating = True
End Sub