[Asinkrit]

Держи,,

Код:

procedure TForm1.Button1Click(Sender: TObject);
type
  tRec = record
   Str:String;
   aCnt:Integer;
  end;
var
  i,z,cnt:integer;
  b:byte;
  tmpStr:String;
  tmpRecs:array of tRec;
  f:boolean;
begin
  tmpStr:='';
  cnt:=0;
  SetLength(tmpRecs,cnt);
  with Memo1 do
    begin
    for i:=1 to Length(Text) do
      if AnsiUpperCase(Text[i])[1] in ['А'..'Я'] then tmpStr:=tmpStr+LowerCase(Text[i])
        else
          if (Text[i] in [' ',#10,#13]) then
            begin
            f:=false;
            if cnt>0 then
              for z:=Low(tmpRecs) to high(tmpRecs) do
                if tmpStr = tmpRecs[z].Str then
                  begin
                  Inc(tmpRecs[z].aCnt);
                  f:=true;
                  break;
                  end;
            if not f then
              begin
              Inc(cnt);
              SetLength(tmpRecs,cnt);
              with tmpRecs[Pred(cnt)] do
                begin
                Str:=tmpStr;
                aCnt:=1;
                end;
              end;
            tmpStr:='';
            end;
    ValueListEditor1.Strings.Clear;
    for i:=Low(tmpRecs) to high(tmpRecs) do
      with tmpRecs[i] do
        ValueListEditor1.InsertRow(Str,IntToStr(aCnt),false);
    SetLength(tmpRecs,0);
    end;
end;