Sub DemoII()
Application.ScreenUpdating = False
Dim RngSel As Range, RngTmp As Range, i As Long, j As Long
With Selection
  Set RngSel = .Range
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "\[list=[0-9]\]*\[/list\]"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchWildcards = True
      .Execute
    End With
    Do While .Find.Found
      If .InRange(RngSel) = False Then Exit Do
      i = CLng(Split(Split(.Text, "]")(0), "=")(1)) - 1
      j = 0
      Set RngTmp = .Duplicate
      With .Duplicate
        .Paragraphs.First.Range.Text = vbNullString
        .Paragraphs.Last.Range.Text = vbNullString
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = "\[\*\]"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = False
          .MatchWildcards = True
          .Execute
        End With
        Do While .Find.Found
          j = j + 1
          If .InRange(RngTmp) = False Then Exit Do
          .Text = i + j & ". "
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
End With
RngSel.Select
Set RngSel = Nothing:Set RngTmp = Nothing
Application.ScreenUpdating = True
End Sub