Sub t()
  Dim a()
  a = Sheets("Лист1").[a1].CurrentRegion.Value
  Set r = CreateObject("vbscript.regexp")
  Set d = CreateObject("scripting.dictionary")
  d.comparemode = 1
  
  r.MultiLine = True: r.Global = True: r.IgnoreCase = True
  r.Pattern = "[^-а-яёa-z]([-а-яёa-z]+)"
  For Each x In a
    If Not IsEmpty(x) Then
      Set m = r.Execute(" " & x)
      If m.Count Then
        For i = 0 To m.Count - 1
          d.Item(m(i).SubMatches(0)) = d.Item(m(i).SubMatches(0)) + 1
        Next
      End If
    End If
  Next
  Sheets("Лист2").Cells.Clear
  Sheets("Лист2").[a1:b1].Resize(d.Count) = Application.Transpose(Array(d.keys, d.items))
End Sub

Private Function ReplaceText(ByRef astring As Variant, ByRef Mask As String, ByRef Model As String) As String
'Функция заменяет совпавшую с маской часть строки в соответствии с указанной моделью
Dim re As RegExp

Set re = New RegExp
re.Pattern = Mask
re.Global = True
re.IgnoreCase = True
re.MultiLine = False

ReplaceText = re.Replace(astring, Model)
End Function