Как написать процедуру поиска

@Artemlarin · Регистрация: 19.11.2013

Author24 — интернет-сервис помощи студентам

Допустим существует папка, в ней порядка 30 файлов xls. По содержанию они идентичны, различаются лишь одной буквой в одной и той же ячейке (в моем случае В6).Как мне организовать поиск файлов (которые удовлетворяют условию что заданное значение равно значению в ячейке, например я выбираю А, программа смотрит в этой ячейке А=А, если да то дальше, нет переход к другому файлу(в этой ячейке может быть или А, или В, или С) и вывод их названий допустим в listbox. То есть три кнопки А,В,С и listbox. Выбираю А, выводит все файлы, где в ячейке В6 есть А, выбираю В-файлы с В и т.д.
Заранее спасибо.

@teleprog · 30.11.2013, 15:23

Вроде бы так

Delphi

procedure TForm1.Button4Click(Sender: TObject);
Var
ef,sred:real;
cnt:integer;
begin
ef:=0;
sred:=0;
cnt:=0;
with StringGrid1 do
     begin
for i:=1 to RowCount-2 do
 if StrToFloat(Cells[4,i])=0 then ShowMessage('qwerty') else
   begin
     ef:=ef+StrToFloat(Cells[3,i]);
     inc(cnt); 
     sred:=ef/(cnt-1);
     Cells[3,RowCount-1]:=FloatToStr(sred);
   end;
     end;
end;

@Artemlarin · 01.12.2013, 08:53 **[ТС]**

Выдает ошибку

@Artemlarin · 01.12.2013, 09:09 **[ТС]**

Чуть переделал и наконец то заработала

Delphi

procedure TForm1.Button4Click(Sender: TObject);
Var
ef,sred:real;
cnt:integer;
begin
ef:=0;
sred:=0;
cnt:=StringGrid1.RowCount-2;
with StringGrid1 do
     begin
for i:=1 to RowCount-2 do
 if StrToFloat(Cells[4,i])=0 then Dec(cnt) else
   begin
     ef:=ef+StrToFloat(Cells[3,i]);
     sred:=ef/(cnt);
     Cells[3,RowCount-1]:=FloatToStr(sred);
   end;
      end;
end;

@Artemlarin · 01.12.2013, 09:12 **[ТС]**

Спасибо тебе огромное за помощь!

Надеюсь я тебе не надоел со своими вопросами?

@Artemlarin · 23.12.2013, 15:10 **[ТС]**

teleprog, привет. Сейчас пытаюсь сделать тоже самое, но с word файлами. Опять столкнулся с новыми проблемами, ответы на которые никак не могу найти. Надеюсь на твою помощь. Суть проблемы: существует word файл, по типу тех которые на excel я скидывал, в нем по строкам идет отчет о работе машины. Мне надо опять же из определенного места из файла взять текст и перенести его в stringgrid. По типу того же что, мы делали до этого, но в excel идет работа с ячейками, а здесь с range,насколько я понял. Вот допустим есть строка
"Total Production : 1461000 cig.", как мне взять число, которое находится после разделителя и перенести его в stringgrid. Отчеты всегда одинаковые, то есть Все что до разделителя (название ошибок и текст) всегда на одном и том же месте, а вот цифры всегда разные.

Вот мой код:

Delphi

unit Unit41;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ComObj, Grids;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    ListBox1: TListBox;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    Label3: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    A: TEdit;
    Label4: TLabel;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  MWord, wdDoc, wdRng, wdFindContinue: Variant;
  i,n,w: integer;
  s,text_:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const wdWord=2;
Var SR:TSearchRec;
    FindRes,n,nn, cnt:Integer;
    s,r,t,q,w,qwe: shortstring;
BEGIN
if A.text='A' then
begin
 
ListBox1.Clear;
FindRes:=FindFirst('c:\Hauni\2013*.01P',faAnyFile,SR);
While FindRes=0 do
   begin
     
      if (FileDateToDateTime(SR.Time)<DateTimePicker1.Date) then // если у файла (каталога) дата создания меньше, чем установлено в DateTimePicker1, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date+0.9999) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
            ListBox1.Items.Add(SR.Name);
      n:=ListBox1.Count;
      FindRes:=FindNext(SR);
      for i:=0 to ListBox1.Count-1 do
     begin
    MWord := CreateOleObject('Word.Application');
    MWord.Documents.Open('c:\Hauni\'+ListBox1.Items[i]);
   text_:='Total';
 
   MWord.Selection.Find.Forward:=True;
   MWord.Selection.Find.Text:=text_;
   MWord.Selection.Move(wdWord,3);
   if MWord.Selection.Find.Execute then qwe:=MWord.Selection.Text;
   StringGrid1.Cells[1,1]:=qwe;
    end;
     MWord.Quit;
end;
 
 
 
 
 
 
 
FindClose(SR);
nn:=0;
 
 with StringGrid1 do
  begin
 
{определяем текст содержимого ячейки таблицы с координатами ACol, ARow,
  где ACol - номер колонки, а ARow - номер строки.}
   Cells[1,0]:='Date';
   Cells[2,0]:='Total Production';
   Cells[3,0]:='Machine Efficiency';
   Cells[4,0]:='Select date';
   Cells[0,RowCount-1]:='Total';
  end;
 
end;
END;

Word файлы прикрепил

@Artemlarin · 24.12.2013, 18:26 **[ТС]**

teleprog, Вот изменил немного код, сделал поиск по номеру слова, в принципе мне так подходит, т.к. всегда все они на одном и том же месте, только вот вопрос теперь возник, как мне во втором переносе добавить несколько слов, то есть у меня в word файле дата написана как: 23.12.2013, то есть получается в stringgrid мне надо перенести слова с 23 по 2013 (5 слов), как мне это сделать? и еще почему у меня не всегда закрываются word файлы после работы с ними?

Delphi

unit Unit41;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ComObj, Grids;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    ListBox1: TListBox;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    Label3: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    A: TEdit;
    Label4: TLabel;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  MWord, wdDoc, wdRng, wdFindContinue,  fragment,frag: Variant;
  i,n,w: integer;
  s,text_:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var SR:TSearchRec;
    FindRes,n,nn, cnt:Integer;
    s,r,t,q,w,qwe,asd: shortstring;
BEGIN
if A.text='A' then
begin
 
ListBox1.Clear;
FindRes:=FindFirst('c:\Hauni\2013*.01P',faAnyFile,SR);
While FindRes=0 do
   begin
     
      if (FileDateToDateTime(SR.Time)<DateTimePicker1.Date) then // если у файла (каталога) дата создания меньше, чем установлено в DateTimePicker1, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date+0.9999) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
            ListBox1.Items.Add(SR.Name);
      n:=ListBox1.Count;
      FindRes:=FindNext(SR);
      for i:=0 to ListBox1.Count-1 do
     begin
    MWord := CreateOleObject('Word.Application');
    MWord.Documents.Open('c:\Hauni\'+ListBox1.Items[i]);
    MWord.Visible := false;
    MWord.DisplayAlerts := False;
   text_:='Total';
    MWord.ActiveDocument.Words.Item(112).Select;
  fragment := MWord.Selection.Range;
  qwe:=MWord.Selection.Range;
  with StringGrid1 do
       RowCount:=n+2;
      StringGrid1.Cells[2,n]:=qwe;
          MWord.ActiveDocument.Words.Item(35).Select;
  frag:= MWord.Selection.Range;
  asd:=MWord.Selection.Range;
  with StringGrid1 do
       RowCount:=n+2;
      StringGrid1.Cells[1,n]:=asd;
    end;
    MWord.Application.Documents.Close;
     MWord.Quit;
end;
 
 
 
 
 
 
 
FindClose(SR);
nn:=0;
 
 with StringGrid1 do
  begin
 
{определяем текст содержимого ячейки таблицы с координатами ACol, ARow,
  где ACol - номер колонки, а ARow - номер строки.}
   Cells[1,0]:='Date';
   Cells[2,0]:='Total Production';
   Cells[3,0]:='Machine Efficiency';
   Cells[4,0]:='Select date';
   Cells[0,RowCount-1]:='Total';
  end;
 
end;
END;
 
 
procedure TForm1.Button2Click(Sender: TObject);
begin
for i:= 0 to Stringgrid1.ColCount-1 do
  StringGrid1.Cols[i].Clear;
 
end;
 
procedure TForm1.Button3Click(Sender: TObject);
var
 Excel, Sheet: variant;
 Col, Row: word;
begin
  Excel := CreateOleObject('Excel.Application');// создаем экземпляр Excel
 
    Excel.Visible := false;
 
    Excel.Workbooks.Add;// добавляем новую книгу
    Sheet := Excel.ActiveWorkbook.Worksheets[1];
try
    for Col := 0 to StringGrid1.ColCount - 1 do
      for Row := 0 to StringGrid1.RowCount - 1 do
        Sheet.Cells[Row + 1, Col + 1] := StringGrid1.Cells[Col, Row];//перенос
 
    Excel.ActiveWorkbook.SaveAs('C:\MyFile.xlsx');
ShowMessage('Сохранено');
  finally
    Excel.Application.Quit;
    Excel := unassigned; // завершаем процесс
  end;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
Var
ef,sred:real;
cnt:integer;
begin
ef:=0;
sred:=0;
cnt:=StringGrid1.RowCount-2;
with StringGrid1 do
     begin
for i:=1 to RowCount-2 do
 if StrToFloat(Cells[4,i])=0 then Dec(cnt) else
   begin
     ef:=ef+StrToFloat(Cells[3,i]);
     sred:=ef/(cnt);
     Cells[3,RowCount-1]:=FloatToStr(sred);
   end;
      end;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
begin
ListBox1.Clear
end;
 
end.

Добавлено через 22 часа 54 минуты
teleprog, не получается по номеру слова. Все таки файлы не много разные. То есть получается мне надо как то искать слово, допустим "Total Production :" и все что после него и до следующего слова переносить в stringgrid? (если предложение такого типа и мне надо вытащить только цифры "Total Production : 1461000 cig.")

@Artemlarin 11 / 0 / 0 Регистрация: 19.11.2013 Сообщений: 24
		1
	Как написать процедуру поиска 26.11.2013, 20:52. Показов 2096. Ответов 25 Метки нет (Все метки) Допустим существует папка, в ней порядка 30 файлов xls. По содержанию они идентичны, различаются лишь одной буквой в одной и той же ячейке (в моем случае В6).Как мне организовать поиск файлов (которые удовлетворяют условию что заданное значение равно значению в ячейке, например я выбираю А, программа смотрит в этой ячейке А=А, если да то дальше, нет переход к другому файлу(в этой ячейке может быть или А, или В, или С) и вывод их названий допустим в listbox. То есть три кнопки А,В,С и listbox. Выбираю А, выводит все файлы, где в ячейке В6 есть А, выбираю В-файлы с В и т.д. Заранее спасибо. 0

@Artemlarin 11 / 0 / 0 Регистрация: 19.11.2013 Сообщений: 24
	01.12.2013, 08:53 [ТС]	22
	Выдает ошибку Миниатюры 0

@Artemlarin 11 / 0 / 0 Регистрация: 19.11.2013 Сообщений: 24
	01.12.2013, 09:12 [ТС]	24
	Спасибо тебе огромное за помощь! Надеюсь я тебе не надоел со своими вопросами? 0

	24.12.2013, 18:26