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

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

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

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

@teleprog · 27.11.2013, 03:08

В архиве полный пример.

А вот кусок кода, по перебору файлов и сравнению ячеек.

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
procedure TForm1.btn1Click(Sender: TObject);
var  i,j: integer;
     ExcelApp,    WorkSheet: OLEVariant;
     s:string;
begin
   try
    ExcelApp := GetActiveOleObject('Excel.Application');
  except
    try
    ExcelApp:=CreateOleObject('Excel.Application');
    except
      MessageDlg(        'Íå óäàëîñü ïîäêëþ÷èòüñÿ ê Excel. Äåéñòâèå îòìåíåíî.'        ,mtError, [mbOK], 0      );
      Exit;
    end;
  end;
  for i:=0 to fllst1.Count-1 do
  begin
    ExcelApp.Workbooks.Open(dirlst1.Directory+fllst1.Items[i]);
    WorkSheet:=ExcelApp.ActiveWorkbook.ActiveSheet;
    s:= WorkSheet.Range['B6'].Value;
    if s = edit1.text then
      lst1.AddItem(dirlst1.Directory+fllst1.Items[i],nil);
  end;
end;

@Artemlarin · 27.11.2013, 12:07 **[ТС]**

Спасибо большое! Очень помогло

@Artemlarin · 27.11.2013, 14:05 **[ТС]**

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
unit Unit4;
 
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;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label2: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Excel, WorkSheet: Variant;
  i,n: integer;
  s:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var SR:TSearchRec; 
    FindRes:Integer;
    Nomer,s : shortstring;
begin 
ListBox1.Clear;
ListBox2.Clear;
FindRes:=FindFirst('c:\focke\?350*.*',faAnyFile,SR); 
While FindRes=0 do 
   begin
      if (SR.Size<30000) then
         begin
            FindRes:=FindNext(SR); 
            Continue;
         end;
      if (FileDateToDateTime(SR.Time)<DateTimePicker1.Date) then // если у файла (каталога) дата создания меньше, чем установлено в DateTimePicker1, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      ListBox1.Items.Add(SR.Name);
      FindRes:=FindNext(SR);
      for i:=0 to ListBox1.Count-1 do
         begin
      Excel := CreateOleObject('Excel.Application');
      Excel.Workbooks.Open('c:\focke\'+ListBox1.Items[i]);
      WorkSheet:=Excel.ActiveWorkbook.ActiveSheet;
      s:=WorkSheet.Range['B6'].Text;
        if s='''A' then
      ListBox2.AddItem(ListBox1.Items[i],nil);
      Excel.Quit;
        end;
 
   end;
FindClose(SR);
end;
 
end.

Почему не работает listbox2 подскажите пожалуйста? Сравниваю значение из ячейки с заданным значением, если удовлетворяет условию то записываем в listbox2. Причем если меняю ячейку на другую, допустим В10 (в ней просто цифры 144000), и задаю условие что оно равно 144000, то все работает, а если в ячейке есть текст, не работает.

@teleprog · 27.11.2013, 15:45

if s='''A' then
Зачем двойная кавычка перед А ?

@Artemlarin · 28.11.2013, 09:54 **[ТС]**

В этом архиве лежат файлы excel с которыми я работаю. В них почему то текст в ячейках пишется так:'A (эти файлы создает Dos машины, а мне их только нужно обработать, не изменяя). Двойную ковычку ставлю, чтобы delphi видел ее в ячейке. Но он все равно ее не видит.

Добавлено через 37 минут
Причем если создавать самому новый xls файл, в нем вручную забивать В6=А и так далее, то все работает. Почему то программа не может прочитать текст с моих файлов, или я не правильно ввожу условия.

Добавлено через 4 минуты
И еще вопрос: у меня в 1 колонку stringrid1 записывается дата, во вторую число (кол-во изготовленной продукции), а в 3-ю я хочу чтобы значение из второй колонки делилось на число 1440, и записывался только ответ (в моем случае значение t разделить на число 1440). Как я могу это сделать? Вот мой код

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
unit Unit4;
 
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;
    ListBox2: TListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Excel, WorkSheet: Variant;
  i,n: integer;
  s:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var SR:TSearchRec; 
    FindRes:Integer;
    Nomer,s,r,t,ME: shortstring;
    k:real;
begin 
ListBox1.Clear;
ListBox2.Clear;
FindRes:=FindFirst('c:\focke\?350*.*',faAnyFile,SR); 
While FindRes=0 do 
   begin
      if (SR.Size<5000) then
         begin
            FindRes:=FindNext(SR); 
            Continue;
         end;
      if (FileDateToDateTime(SR.Time)<DateTimePicker1.Date) then // если у файла (каталога) дата создания меньше, чем установлено в DateTimePicker1, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      ListBox1.Items.Add(SR.Name);
      FindRes:=FindNext(SR);
      for i:=0 to ListBox1.Count-1 do
         begin
      Excel := CreateOleObject('Excel.Application');
      Excel.Workbooks.Open('c:\focke\'+ListBox1.Items[i]);
      WorkSheet:=Excel.ActiveWorkbook.ActiveSheet;
      s:=WorkSheet.Range['B6'].Text;
      r:=WorkSheet.Range['B7'].Text;
      t:=WorkSheet.Range['F38'].Text;
        if s='A' then
      StringGrid1.Cells[1,i+1]:=r;
        if s='A' then
      StringGrid1.Cells[2,i+1]:=t;
        if s='A' then
      ListBox2.AddItem(ListBox1.Items[i],nil);
      
      
      StringGrid1.Cells[3,1]:=ME;
      Excel.Quit;
        end;
          with StringGrid1 do
  begin
 
{определяем текст содержимого ячейки таблицы с координатами ACol, ARow,
  где ACol - номер колонки, а ARow - номер строки.}
   Cells[1,0]:='Date';
   Cells[2,0]:='Production Volume';
   Cells[3,0]:='Machine Efficiency';
   Cells[0,4]:='Total';
  end;
   end;
FindClose(SR);
end;
 
end.

@teleprog · 28.11.2013, 12:12

Добавьте мемо на форму и выведите в нее значение ячейки, скопируйте и вставьте в код программы. Просто может быть там "А" или в другой раскладке или вместе с каким нибудь невидимым символом.

memo1.lines.add('____'+WorkSheet.Range['B6'].Text+'____');

@Artemlarin · 28.11.2013, 14:05 **[ТС]**

Спасибо огромнейшее

Уже дня 2 думаю над этой "А"!Оказалось все так просто: там после нее пробелов 10 еще стоит, поэтому просто А он не видел)

Добавлено через 9 минут
teleprog, Посмотри пожалуйста

Delphi
1
2
3
4
5
with form1.StringGrid1 do
begin
for i:=1 to RowCount-2 do
Cells[2,RowCount-1]:=FloatToStr(StrToInt(Cells[2,1])+StrToInt(Cells[2,i]));
end;

Хочу посчитать сумму значений всех строк второго столбца таблицы и вывести в последнюю строчку.

@teleprog · 28.11.2013, 14:15

Лучше вот так наверно сделать

Delphi
1
2
3
4
5
6
7
8
9
var nn:integer;
//........
nn:=0;
with form1.StringGrid1 do
begin
  for i:=1 to RowCount-2 do 
     nn:=nn+StrToInt(Cells[2,i]));
end;
Cells[2,RowCount-1]:=FloatToStr(nn);

@Artemlarin · 28.11.2013, 14:31 **[ТС]**

teleprog, Почти все работает, только возникает вопрос: почему когда выбрано 3 файла, то есть таблица заполнена, считает все на ура, если выбрано 2 файла, предпоследняя строка не заполнена, он выдает ошибку? Насколько я понимаю он не находит значение в предпоследней строке, из-за этого не считает сумму, может дело в заполнении таблицы? RowCount фиксировано 5, но не всегда в 3 строке есть значение.

Добавлено через 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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
unit Unit4;
 
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;
    ListBox2: TListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Excel, WorkSheet: Variant;
  i,n: integer;
  s:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var SR:TSearchRec; 
    FindRes,nn:Integer;
    s,r,t,q: shortstring;
begin 
ListBox1.Clear;
ListBox2.Clear;
FindRes:=FindFirst('c:\focke\?350*.*',faAnyFile,SR); 
While FindRes=0 do 
   begin
      if (SR.Size<65000) then
         begin
            FindRes:=FindNext(SR); 
            Continue;
         end;
      if (FileDateToDateTime(SR.Time)<DateTimePicker1.Date) then // если у файла (каталога) дата создания меньше, чем установлено в DateTimePicker1, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      ListBox1.Items.Add(SR.Name);
      FindRes:=FindNext(SR);
      for i:=0 to ListBox1.Count-1 do
         begin
      Excel := CreateOleObject('Excel.Application');
      Excel.Workbooks.Open('c:\focke\'+ListBox1.Items[i]);
      WorkSheet:=Excel.ActiveWorkbook.ActiveSheet;
      s:=WorkSheet.Range['B6'].Text;
      r:=WorkSheet.Range['B7'].Text;
      t:=WorkSheet.Range['F38'].Text;
        if s='A                                  ' then
      StringGrid1.Cells[1,i+1]:=r;
        if s='A                                  ' then
      StringGrid1.Cells[2,i+1]:=t;
        if s='A                                  ' then
      ListBox2.AddItem(ListBox1.Items[i],nil);
        if s='A                                  ' then
      q:=FloatToStr(StrToInt(StringGrid1.Cells[2,i+1])/1440);
      StringGrid1.Cells[3,i+1]:=q;
      Excel.Quit;
        end;
          with StringGrid1 do
  begin
 
{определяем текст содержимого ячейки таблицы с координатами ACol, ARow,
  где ACol - номер колонки, а ARow - номер строки.}
   Cells[1,0]:='Date';
   Cells[2,0]:='Production Volume';
   Cells[3,0]:='Machine Efficiency';
   Cells[0,4]:='Total';
  end;
   end;
FindClose(SR);
nn:=0;
with form1.StringGrid1 do
begin
  for i:=1 to RowCount-2 do 
     nn:=nn+StrToInt(Cells[2,i]);
 
Cells[2,RowCount-1]:=FloatToStr(nn);
 end;
end;
 
end.

@teleprog · 28.11.2013, 16:40

Поменяй на

Delphi
1
2
 for i:=1 to RowCount-2 do 
     nn:=nn+StrToIntDef(Cells[2,i],0);

@Artemlarin · 29.11.2013, 00:53 **[ТС]**

Спасибо, все заработало.

Добавлено через 23 минуты
teleprog, Если тебе не сложно, можешь ответить на пару вопросов, интересующих меня с момента начала работы над программой и возникающих по ходу.
1) В listbox1 выводит названия по алфавиту, а не по порядку, как он ищет (в следствии чего в stringgrid он может записать дату вначале 29.08.2013, а потом 26.08.2013). То есть по моим условиям проход он осуществляет: вначале смотрит размер, далее время создания, после чего записывает их в listbox. Допустим один файл называется А350290813.13А, а другой С350260813.13А. Как ты видишь файл С350260813.13А был создан раньше (26 августа), то есть по сути он первый должен попасть в listbox, а первым почему то попадает А350290813.13А. Можно это как то исправить? Как бы это не столь важно, но для красоты в stringgrid и ради интереса спрашиваю.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
begin
ListBox1.Clear;
FindRes:=FindFirst('c:\focke\?350*.*',faAnyFile,SR);
While FindRes=0 do 
   begin
      if (SR.Size<65000) then
         begin
            FindRes:=FindNext(SR); 
            Continue;
         end;
      if (FileDateToDateTime(SR.Time)<DateTimePicker1.Date) then // если у файла (каталога) дата создания меньше, чем установлено в DateTimePicker1, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      ListBox1.Items.Add(SR.Name);
      FindRes:=FindNext(SR);

2)При поиске по второй дате (по какое число), выбранная дата не включена в список, то есть в Listbox записываются все файлы до нее. Я пробовал менять > на =, программа ругается. Можно как то это исправить?

Delphi
1
2
3
4
5
if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;

3)Самый интересующий меня вопрос. Как изменять StringGrid по содержимому, то есть сколько дат, столько и строк + 1 для total? Допустим, я забиваю даты с 26 по 29, подходящих находит 3 файла, из них значения переносит в stringgrid, все нормально, потому что я задал 5 строк,а если я задаю допустим с 26 по 28, подходящих уже 2 файла, предпоследняя строка пустая, а если задаю с 26 по 30, уже не залезает в таблицу. Вот окончательный код полностью:

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
unit Unit4;
 
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;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Excel, WorkSheet: Variant;
  i,n,w: integer;
  s:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var SR:TSearchRec; 
    FindRes,nn:Integer;
    s,r,t,q: shortstring;
begin
ListBox1.Clear;
FindRes:=FindFirst('c:\focke\?350*.*',faAnyFile,SR);
While FindRes=0 do 
   begin
      if (SR.Size<65000) then
         begin
            FindRes:=FindNext(SR); 
            Continue;
         end;
      if (FileDateToDateTime(SR.Time)<DateTimePicker1.Date) then // если у файла (каталога) дата создания меньше, чем установлено в DateTimePicker1, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      if (FileDateToDateTime(SR.Time)>DateTimePicker2.Date) then // если у файла (каталога) дата создания больше, чем установлено в DateTimePicker2, то
         begin
            FindRes:=FindNext(SR); // продолжить поиск
            Continue; // продолжить цикл
         end;
      ListBox1.Items.Add(SR.Name);
      FindRes:=FindNext(SR);
      for i:=0 to ListBox1.Count-1 do
         begin
      Excel := CreateOleObject('Excel.Application');
      Excel.Workbooks.Open('c:\focke\'+ListBox1.Items[i]);
      WorkSheet:=Excel.ActiveWorkbook.ActiveSheet;
      s:=WorkSheet.Range['B6'].Text;
      r:=WorkSheet.Range['B7'].Text;
      t:=WorkSheet.Range['F38'].Text;
        if s='A                                  ' then
      StringGrid1.Cells[1,i+1]:=r;
        if s='A                                  ' then
      StringGrid1.Cells[2,i+1]:=t;
        if s='A                                  ' then
      q:=FloatToStr(StrToInt(StringGrid1.Cells[2,i+1])/1440);
      StringGrid1.Cells[3,i+1]:=q;
      Excel.Quit;
        end;
          with StringGrid1 do
  begin
 
{определяем текст содержимого ячейки таблицы с координатами ACol, ARow,
  где ACol - номер колонки, а ARow - номер строки.}
   Cells[1,0]:='Date';
   Cells[2,0]:='Production Volume';
   Cells[3,0]:='Machine Efficiency';
   Cells[0,4]:='Total';
  end;
   end;
FindClose(SR);
nn:=0;
with form1.StringGrid1 do
begin
  for i:=1 to RowCount-2 do 
     nn:=nn+StrToIntDef(Cells[2,i],0);
 
Cells[2,RowCount-1]:=FloatToStr(nn);
 end;
end;
 
end.

4)Как правильно объединить 2 проекта, просто при add existing project он их вроде как соединяет, но получается две формы Form1. А мне надо из одной программы вызывать другую. Может я неправильно соединяю?

Буду очень рад и благодарен если ты ответишь на все вопросы

@teleprog · 29.11.2013, 02:11

1) Сортируй вручную
Поищи по форуму по фразе "сортировка listbox"
например ListBox: сортировка по дате создания
2) к DateTimePicker2.Date прибавь 0.9999
if (FileDateToDateTime(SR.Time)>(DateTimePi cker2.Date+0.9999)) then //
3) добавь счетчик дат, и при каждой новой дате меняй размер грида Stringgrid1.RowCount:= N+1;
4) сохрани одну из форм под другим именем, и добавь ее во второй проект

@Artemlarin · 29.11.2013, 15:13 **[ТС]**

Спасибо за ответы на мои вопросы. Решил проэксперементировать с переносом stringgrid в excel. Процедуру сделал через кнопку Save, все сохраняет, но почему то 4 столбец, где считается моя эффективность, в excel переносится #, а все остальные отлично. В чем может быть причина не подскажешь? И еще интересует вопросик: могу ли я в delphi прописать, чтобы при переносе stringgrid, ячейки создаваемые в excel изменяли размер под входящий в него текст? Готовый проект и получившийся excel файл прилагаю в архиве.

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
unit Unit4;
 
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;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Excel, WorkSheet: Variant;
  i,n,w: integer;
  s:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var SR:TSearchRec; 
    FindRes,nn,n:Integer;
    s,r,t,q: shortstring;
    ef,sred:real;
begin
ListBox1.Clear;
FindRes:=FindFirst('c:\focke\?350*.*',faAnyFile,SR);
While FindRes=0 do
   begin
      if (SR.Size<65000) then
         begin
            FindRes:=FindNext(SR); 
            Continue;
         end;
      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
      Excel := CreateOleObject('Excel.Application');
      Excel.Workbooks.Open('c:\focke\'+ListBox1.Items[i]);
      WorkSheet:=Excel.ActiveWorkbook.ActiveSheet;
      s:=WorkSheet.Range['B6'].Text;
      r:=WorkSheet.Range['B7'].Text;
      t:=WorkSheet.Range['F38'].Text;
 
      with StringGrid1 do
      RowCount:=n+2;
        if s='A                                  ' then
         with StringGrid1 do
      StringGrid1.Cells[1,n]:=r;
        if s='A                                  ' then
         with StringGrid1 do
      StringGrid1.Cells[2,n]:=t;
        if s='A                                  ' then
         with StringGrid1 do
      q:=FloatToStr(StrToInt(StringGrid1.Cells[2,n])/1440);
       with StringGrid1 do
      StringGrid1.Cells[3,n]:=q;
      Excel.Quit;
        end;
 
   end;
FindClose(SR);
nn:=0;
ef:=0;
sred:=0;
 with StringGrid1 do
  begin
 
{определяем текст содержимого ячейки таблицы с координатами ACol, ARow,
  где ACol - номер колонки, а ARow - номер строки.}
   Cells[1,0]:='Date';
   Cells[2,0]:='Production Volume';
   Cells[3,0]:='Machine Efficiency';
   Cells[0,RowCount-1]:='Total';
  end;
with form1.StringGrid1 do
 begin
  for i:=1 to RowCount-2 do
     nn:=nn+StrToIntDef(Cells[2,i],0);
Cells[2,RowCount-1]:=FloatToStr(nn);
for i:=1 to RowCount-2 do
     ef:=ef+StrToFloat(Cells[3,i]);
     sred:=ef/(i-1);
     Cells[3,RowCount-1]:=FloatToStr(sred);
 
 
 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;
end.

@Artemlarin · 29.11.2013, 16:28 **[ТС]**

И еще вопросик возник: попытался дописать код по подсчету эффективности (формула для подсчета:сумма всех значений эффективности(4 столбик) деленное на сумму дней), потому что бывает так, в некоторые дни она равна 0, так как машина стояла, и получается он считает кол-во дней вместе с этим днем, в итоге не правильно считает общую эффективность. После внесенных изменений в коде, считает все равно по прежнему. Посмотри пожалуйста.

Delphi
1
2
3
4
5
for i:=1 to RowCount-2 do
 if StrToFloat(Cells[3,i])=0 then ShowMessage('qwe') else
     ef:=ef+StrToFloat(Cells[3,i]);
     sred:=ef/(i-1);
     Cells[3,RowCount-1]:=FloatToStr(sred);

@teleprog · 29.11.2013, 20:56

#- колонку раздвинь мышкой.

Как Сделать авторазмер столбцов и рядов
XL.Columns("A:A").EntireColumn.AutoFit 'устанавливает авторазмер столбца A
XL.Columns("B:B").EntireColumn.AutoFit 'устанавливает авторазмер столбца B
XL.Rows("1:1").EntireRow.AutoFit 'устанавливаем авторазмер ряда 1
XL.Rows("2:2").EntireRow.AutoFit 'устанавливаем авторазмер ряда 2

По формуле- непойму что неправильно, нужен пример данных которые расчитываются и что выдает, и почему не подходит.

@Artemlarin · 29.11.2013, 22:24 **[ТС]**

#-при раздвигание открывает, но не ставит разделители (число дробное, а пишет все цифры подряд без запятой), может проблема в типах данных?

По поводу формулы: данные по которым рассчитывается в архиве, результат на скриншоте + сам проект в архиве.

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
unit Unit4;
 
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;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Excel, WorkSheet: Variant;
  i,n,w: integer;
  s:string;
 
implementation
 
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var SR:TSearchRec; 
    FindRes,nn,n:Integer;
    s,r,t,q: shortstring;
    ef,sred:real;
begin
ListBox1.Clear;
FindRes:=FindFirst('c:\focke\?350*.*',faAnyFile,SR);
While FindRes=0 do
   begin
      if (SR.Size<65000) then
         begin
            FindRes:=FindNext(SR); 
            Continue;
         end;
      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
      Excel := CreateOleObject('Excel.Application');
      Excel.Workbooks.Open('c:\focke\'+ListBox1.Items[i]);
      WorkSheet:=Excel.ActiveWorkbook.ActiveSheet;
      s:=WorkSheet.Range['B6'].Text;
      r:=WorkSheet.Range['B7'].Text;
      t:=WorkSheet.Range['F38'].Text;
 
      with StringGrid1 do
      RowCount:=n+2;
        if s='A                                  ' then
         with StringGrid1 do
      StringGrid1.Cells[1,n]:=r;
        if s='A                                  ' then
         with StringGrid1 do
      StringGrid1.Cells[2,n]:=t;
        if s='A                                  ' then
         with StringGrid1 do
      q:=FloatToStr(StrToInt(StringGrid1.Cells[2,n])/1440);
       with StringGrid1 do
      StringGrid1.Cells[3,n]:=q;
      Excel.Quit;
        end;
 
   end;
FindClose(SR);
nn:=0;
ef:=0;
sred:=0;
 with StringGrid1 do
  begin
 
{определяем текст содержимого ячейки таблицы с координатами ACol, ARow,
  где ACol - номер колонки, а ARow - номер строки.}
   Cells[1,0]:='Date';
   Cells[2,0]:='Production Volume';
   Cells[3,0]:='Machine Efficiency';
   Cells[0,RowCount-1]:='Total';
  end;
with form1.StringGrid1 do
 begin
  for i:=1 to RowCount-2 do
     nn:=nn+StrToIntDef(Cells[2,i],0);
Cells[2,RowCount-1]:=FloatToStr(nn);
for i:=1 to RowCount-2 do
 if StrToFloat(Cells[3,i])=0 then ShowMessage('qwe') else
     ef:=ef+StrToFloat(Cells[3,i]);
     sred:=ef/(i-1);
     Cells[3,RowCount-1]:=FloatToStr(sred);
 
 
 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;
end.

Что не подходит: посмотри исходник от 4.11.2013, там кол-во продукции=0, поэтому эффективность=0 (это происходит если линия стоит или выходной день, как раз был выходной). Программа берет этот файл, так как он подходит по всем параметрам и начинает работать с ним (записывает в столбики 0), в итоге когда считаем среднюю эффективность по моей формуле (сумма всех эффективностей деленное на кол-во дней) получаем то, что программа делит сумму не на 4 рабочих дня (где эффективность не равна 0), а на 5. (то есть если самому посчитать, по этим данным без учета этого дня должно быть примерно 67, просто это реально важно, мы не всегда когда в ручную считаем эффективность учитываем этот 0, даже иногда не считаем те дни, в которых машина сделала меньше 50000). Можно как то сделать (наверно очень сложно?) так, чтобы я сам выбирал те дни по которым считать эффективность, то есть вначале он выводит мне все дни (и те где 0, и те где не =0), подходящие моему поиску, потом я выбираю (отмечаю) те даты, по которым надо считать эффективнось? То есть на сколько я понимаю надо как то разделить программу, вначале он все делает до подсчета эффективности (заполняет полностью таблицу но без 4 столбика), потом выбираю нужные мне даты и нажимаю кнопку, и он тогда только начинает считать.

@teleprog · 29.11.2013, 22:47

В программе надо у всех переменных, участвующих в сложении дробных чисел сделать тип Real.
И соответсвенно использовать тогда StrToFloat, FloatToStr.

По поводу нулей-
Или учитывать только строки без нулей, и соответсвенно подсчитывать кол-во ненулевых для среднего.
Или добавить столбец с еденичками, которые можно редактировать на нули. Если 1 то учитываем эту строку, если 0 то пропукскаем.

@Artemlarin · 30.11.2013, 11:39 **[ТС]**

У меня там вроде везде real, и использую StrToFloat, FloatToStr. Код в предыдущем сообщении

Добавлено через 3 минуты
А как не учитывать строки с 0, вроде я условие поставил, а он все равно их учитывает?

@Artemlarin · 30.11.2013, 12:08 **[ТС]**

По поводу единиц: добавил столбик, туда будет заносится единица при каждой записи в stringgrid и его можно редактировать(менять на 0), добавил кнопку и процедуру подсчета с исключением, но не получается у меня исключить, остается все как было

, то есть он пишет сообщение, а потом считает все строки. Может там где 0, сделать удаление данной строки полностью из stringgrid со сдвигом всей таблицы, после чего он как раз будет считать оставшиеся строки? Если да, то как это прописать?

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.Button4Click(Sender: TObject);
Var
ef,sred:real;
begin
ef:=0;
sred:=0;
with StringGrid1 do
     begin
for i:=1 to RowCount-2 do
 if StrToFloat(Cells[4,i])=0 then ShowMessage('qwerty') else
     ef:=ef+StrToFloat(Cells[3,i]);
     sred:=ef/(i-1);
     Cells[3,RowCount-1]:=FloatToStr(sred);
     end;
end;

Новые блоги и статьи Все статьи Все блоги /
Отображение реквизитов в документе по условию и контроль их заполнения Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизита табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать контроль заполнения реквизита "ПричинаСписания". . .
wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .	Программное заполнения текстового поля в реквизите формы документа Maks 01.04.2026 Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .

@Artemlarin 11 / 0 / 0 Регистрация: 19.11.2013 Сообщений: 24

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

@Artemlarin 11 / 0 / 0 Регистрация: 19.11.2013 Сообщений: 24
	27.11.2013, 12:07 [ТС]
	Спасибо большое! Очень помогло 0

@teleprog 177 / 149 / 43 Регистрация: 14.08.2008 Сообщений: 1,290
	27.11.2013, 15:45
	if s='''A' then Зачем двойная кавычка перед А ? 0

@teleprog 177 / 149 / 43 Регистрация: 14.08.2008 Сообщений: 1,290
	28.11.2013, 12:12
	Добавьте мемо на форму и выведите в нее значение ячейки, скопируйте и вставьте в код программы. Просто может быть там "А" или в другой раскладке или вместе с каким нибудь невидимым символом. memo1.lines.add('____'+WorkSheet.Range['B6'].Text+'____'); 1

@teleprog 177 / 149 / 43 Регистрация: 14.08.2008 Сообщений: 1,290
	29.11.2013, 02:11
	1) Сортируй вручную Поищи по форуму по фразе "сортировка listbox" например ListBox: сортировка по дате создания 2) к DateTimePicker2.Date прибавь 0.9999 if (FileDateToDateTime(SR.Time)>(DateTimePi cker2.Date+0.9999)) then // 3) добавь счетчик дат, и при каждой новой дате меняй размер грида Stringgrid1.RowCount:= N+1; 4) сохрани одну из форм под другим именем, и добавь ее во второй проект 1

@teleprog 177 / 149 / 43 Регистрация: 14.08.2008 Сообщений: 1,290
	29.11.2013, 20:56
	#- колонку раздвинь мышкой. Как Сделать авторазмер столбцов и рядов XL.Columns("A:A").EntireColumn.AutoFit 'устанавливает авторазмер столбца A XL.Columns("B:B").EntireColumn.AutoFit 'устанавливает авторазмер столбца B XL.Rows("1:1").EntireRow.AutoFit 'устанавливаем авторазмер ряда 1 XL.Rows("2:2").EntireRow.AutoFit 'устанавливаем авторазмер ряда 2 По формуле- непойму что неправильно, нужен пример данных которые расчитываются и что выдает, и почему не подходит. 1

@teleprog 177 / 149 / 43 Регистрация: 14.08.2008 Сообщений: 1,290
	29.11.2013, 22:47
	В программе надо у всех переменных, участвующих в сложении дробных чисел сделать тип Real. И соответсвенно использовать тогда StrToFloat, FloatToStr. По поводу нулей- Или учитывать только строки без нулей, и соответсвенно подсчитывать кол-во ненулевых для среднего. Или добавить столбец с еденичками, которые можно редактировать на нули. Если 1 то учитываем эту строку, если 0 то пропукскаем. 1

@Artemlarin 11 / 0 / 0 Регистрация: 19.11.2013 Сообщений: 24
	30.11.2013, 11:39 [ТС]
	У меня там вроде везде real, и использую StrToFloat, FloatToStr. Код в предыдущем сообщении Добавлено через 3 минуты А как не учитывать строки с 0, вроде я условие поставил, а он все равно их учитывает? 0