Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.92/25: Рейтинг темы: голосов - 25, средняя оценка - 4.92
Ralik
25 / 14 / 1
Регистрация: 13.08.2010
Сообщений: 327
1

Найти и удалить одинаковые строки в memo

15.07.2012, 00:04. Просмотров 4601. Ответов 7
Метки нет (Все метки)

Ребят, подскажите пожалуйста решение.
В поле Memo имеется текст из десятка другого строк.
Требуется проверить каждую строку на предмет имеется ли у неё дубликат во всем списке. Если имеется, то удалить и дублирующее значение и сам оригинал. Если нет повторений, то оставить в списке проверяемую строку.
1
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
15.07.2012, 00:04
Ответы с готовыми решениями:

Удалить одинаковые строки
Доброго времени суток! Интересует вопрос как из текстового файла удалить...

Удалить строки в Memo
Добрый день, Уважаемые Форумчане! В поле Memo у меня есть следующие текст: ...

Удалить определенные строки из Memo
Есть компанент Memo в него загружается через OpenDialog текст из файла txt. как...

Удалить из Memo строки с определенным значением
Добро! Короче в мемо есть строки при нажати на кнопку буттон должна удаляться...

Нужно удалить все одинаковые строки в 2 ListBox - ах
Доброго времени суток! Прошу Вашей помощи, даны два заполненных listbox-а,...

7
antikiler_
1080 / 566 / 79
Регистрация: 07.04.2011
Сообщений: 971
Записей в блоге: 2
15.07.2012, 01:08 2
Можно так сделать
Delphi
1
2
3
4
5
6
7
8
9
10
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.Duplicates := dupIgnore;
  sl.sorted := true;
  sl.AddStrings(Memo1.Lines);
  Memo1.Lines := sl;
  sl.Free;
end;
0
Ralik
25 / 14 / 1
Регистрация: 13.08.2010
Сообщений: 327
15.07.2012, 02:00  [ТС] 3
dupIgnore удаляет только повторяющееся значение, этот вариант и множество других в гугле полно. Я просил удалить и дубликат и сам оригинал того, что повторялось.
Кстати, вот я нашаманил, только почему-то в вечный цикл выпадает.
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var i,j:integer;
  t: TStringList;
begin
t:=TStringList.Create;
t.AddStrings(memo.lines);
t.Sort;
memo.Clear;
memo.Lines.AddStrings(t);
t.Free;
for i:=0 to memo.Lines.Count-1 do
for j:=i+1 to memo.Lines.Count-1 do
if memo.Lines[j]=memo.Lines[i] then
while memo.Lines[j]=memo.Lines[j-1] do begin
memo.Lines.Delete(j);
memo.Lines.Delete(j-1);
end;
 end;
Как победить догадываюсь, но для того, чтобы подтвердить это, мне необходимо узнать число повторов а как это сделать не знаю.
0
antikiler_
1080 / 566 / 79
Регистрация: 07.04.2011
Сообщений: 971
Записей в блоге: 2
15.07.2012, 04:05 4
Только сейчас заметел
то удалить и дублирующее значение и сам оригинал.
По твоему коду не смотрел, сделал свой
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
var
  sl: TStringList;
  i, j: integer;
  str: string;
begin
  sl := TStringList.Create;
  sl.AddStrings(Memo1.Lines);
 
  for i := 0 to Memo1.Lines.Count - 1 do
    begin
      str := Memo1.Lines[i];
      if str = '' then  continue;
      sl.Strings[i] := '';
      j := sl.IndexOf(str);
      if j <> -1 then
        while j <> -1 do
          begin
            sl.Strings[j] := '';
            Memo1.Lines[j] := ''; ;
            j := sl.IndexOf(str);
          end
        else
          sl.Strings[i] := str;
    end;
 
   for i :=sl.Count - 1  downto 0 do
   if sl.Strings[i]='' then sl.Delete(i);
 
  Memo1.Lines := sl;
 
   sl.Free;
end;
Добавлено через 55 минут
Ну немного подправил свой алгоритм
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
var
  sl: TStringList;
  i, j: integer;
  str: string;
begin
  sl := TStringList.Create;
  sl.AddStrings(Memo1.Lines);
 
  for i := 0 to Memo1.Lines.Count - 1 do
    begin
      str := Memo1.Lines[i];
      if str = '' then continue;
      sl.Strings[i] := '';
      if sl.IndexOf(str) <> -1 then
        begin
          sl.Text := StringReplace(sl.Text, str, '', [rfReplaceAll]);
          Memo1.Text := StringReplace(Memo1.Text, str, '', [rfReplaceAll]);
        end
      else  sl.Strings[i] := str;
     end;
 
  for i := sl.Count - 1 downto 0 do
    if sl.Strings[i] = '' then sl.Delete(i);
  Memo1.Lines := sl;
  sl.Free;
end;
и твой
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
var
  sl: TStringList;
  i, j: integer;
  str: string;
begin
sl := TStringList.Create;
  sl.AddStrings(Memo1.Lines);
  sl.Sort;
  // memo1.Clear;
  // memo1.Lines.AddStrings(t);
 
  for i := 0 to sl.Count - 1 do
    for j := i + 1 to sl.Count - 2 do
      if (sl.Strings[j] = '') or (sl.Strings[i] = '') then
        continue
      else if sl.Strings[j] = sl.Strings[i] then
        sl.Text := StringReplace(sl.Text, sl.Strings[j], '', [rfReplaceAll]);
 
  for i := sl.Count - 1 downto 0 do
    if sl.Strings[i] = '' then
      sl.Delete(i);
 
  Memo1.Lines := sl;
  sl.Free;
end;
0
antikiler_
1080 / 566 / 79
Регистрация: 07.04.2011
Сообщений: 971
Записей в блоге: 2
15.07.2012, 04:05 5
Ну немного подправил свой алгоритм
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
var
  sl: TStringList;
  i, j: integer;
  str: string;
begin
  sl := TStringList.Create;
  sl.AddStrings(Memo1.Lines);
 
  for i := 0 to Memo1.Lines.Count - 1 do
    begin
      str := Memo1.Lines[i];
      if str = '' then continue;
      sl.Strings[i] := '';
      if sl.IndexOf(str) <> -1 then
        begin
          sl.Text := StringReplace(sl.Text, str, '', [rfReplaceAll]);
          Memo1.Text := StringReplace(Memo1.Text, str, '', [rfReplaceAll]);
        end
      else  sl.Strings[i] := str;
     end;
 
  for i := sl.Count - 1 downto 0 do
    if sl.Strings[i] = '' then sl.Delete(i);
  Memo1.Lines := sl;
  sl.Free;
end;
и твой
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
var
  sl: TStringList;
  i, j: integer;
  str: string;
begin
sl := TStringList.Create;
  sl.AddStrings(Memo1.Lines);
  sl.Sort;
  // memo1.Clear;
  // memo1.Lines.AddStrings(t);
 
  for i := 0 to sl.Count - 1 do
    for j := i + 1 to sl.Count - 2 do
      if (sl.Strings[j] = '') or (sl.Strings[i] = '') then
        continue
      else if sl.Strings[j] = sl.Strings[i] then
        sl.Text := StringReplace(sl.Text, sl.Strings[j], '', [rfReplaceAll]);
 
  for i := sl.Count - 1 downto 0 do
    if sl.Strings[i] = '' then
      sl.Delete(i);
 
  Memo1.Lines := sl;
  sl.Free;
end;
2
Ralik
25 / 14 / 1
Регистрация: 13.08.2010
Сообщений: 327
15.07.2012, 11:43  [ТС] 6
antikiler_, Огромное спасибо! Только почему
Delphi
1
    for j := i + 1 to sl.Count - 2 do
а не
Delphi
1
    for j := i + 1 to sl.Count - 1 do
???
0
Puporev
Модератор
55470 / 42575 / 29424
Регистрация: 18.05.2008
Сообщений: 100,721
15.07.2012, 11:57 7
Потому что первым делом смотрим от первой до предпоследней строки sl.Count - 2
А потом смотрим от следующей за ней строки(i + 1) до последней sl.Count - 1
индексы строк изменяются от 0 до Count - 1
2
Platinumix
231 / 12 / 3
Регистрация: 28.12.2012
Сообщений: 191
22.03.2013, 04:09 8
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
var s:array[1..1000] of string; 
i,k:integer; 
st:string; 
f,g:text; 
begin 
assign(f,'C:\v\er.txt'); \\ тут укажи путь к файлу 
reset(f); 
while not eof(f) do begin 
readln(f,st); 
k:=k+1; 
s[ k ]:=st; 
end; 
for i:=1 to k do 
writeln(s[ i ]); 
assign(g,'C:\v\er1.txt'); \\ тут укажи путь к новому файлу 
rewrite(g); 
for i:=1 to k do 
if s[ i ] <> s[i+1] then writeln(g,s[ i ]); 
close(f); 
close(g); 
end.
0
22.03.2013, 04:09
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
22.03.2013, 04:09

Как удалить строки с определёнными символами из Memo
У меня в мемо есть слова Мне нужно удалить строки содержащие буквы,символы -...

Удалить из memo все, кроме первой строки
Дайте код пжл чтобы очищал мемо1 кроме первой строки))

Как удалить все строки с Memo после Lines[3]??
Memo3.Lines:=('=1:zdn'+inttostr(a)); ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru