Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String, StrSty As String, i As Long
StrFnd = "1,2,3,4,5"
StrSty = " Strong,Heading 1,Character Style 1,Italic,Character Style 2"
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  .MatchWildcards = True
  For i = 0 To UBound(Split(StrFnd, ","))
    .Text = "#" & Split(StrFnd, ",")(i) & "[A-Za-z]@>"
    .Replacement.Style = Split(StrSty, ",")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub