Тема: Excel поиск
Показать сообщение отдельно
  #1  
Старый 25.02.2011, 10:41
Gevs Gevs вне форума
Прохожий
 
Регистрация: 25.02.2011
Сообщения: 15
Репутация: 12
По умолчанию Excel поиск

если в excelе несколько одноименных ячеек то Find находит только одну, как делать чтоб находил все? Если возможно помогите. заранее спасибо.
Мой код:

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
  exApp, exBook, exSheet, exRng, exCell : Variant;
  Od : TOpenDialog;
  findT,FText: string;
  x,y:string;
begin
  findT:= form1.Edit1.Text;
  Od := OpenDialog1;
  if not Od.Execute then Exit;
  try
    exApp := CreateOleObject('Excel.Application');
    exApp.Visible := False;
    exBook := exApp.WorkBooks.Open(FileName:=Od.FileName);
    exSheet := exBook.WorkSheets[1];
    exRng := exSheet.UsedRange;
    exCell := Unassigned;

    
    exCell := exRng.Find(What:=findT);  //iskat findT v excele


    if TVarData(exCell).VDispatch = nil then
      ShowMessage('No match is found.')
    else
    begin
       ShowMessage('Match is found: Cell[' + IntToStr(exCell.Row) + ';' + IntToStr(exCell.Column) + ']');
       x:=IntToStr(exCell.Row);
       y:=IntToStr(exCell.Column);

          FText:= exRng.Range['A'+ x]; //v excel pokazat A+x yacheyku
          FText:=FText + '  ';
          findT:= exRng.Range['B'+ x];
          FText:= FText+findT;
          FText:=FText + '  ';
          findT:= exRng.Range['C'+ x];
          FText:= FText+findT;
          FText:=FText + '  ';
          findT:= exRng.Range['D'+ x];
          FText:= FText+findT;
          FText:=FText + '  ';
          findT:= exRng.Range['E'+ x];
          FText:= FText+findT;
          FText:=FText + '  ';
          findT:= exRng.Range['F'+ x];
          FText:= FText+findT;
          FText:=FText + '  ';
          findT:= exRng.Range['G'+ x];
          FText:= FText+findT;
          //ne smog vse srazu
         form1.Label1.Caption:= FText;
    end;
     exApp.Quit;
  finally

    exApp := Unassigned;
    exBook := Unassigned;
    exSheet := Unassigned;
    exRng := Unassigned;
    exCell := Unassigned;

  end;

end;


procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
Ответить с цитированием